Compare commits
499
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
5e7e1715af | ||
|
|
674dc6d84e | ||
|
|
f85eb13554 | ||
|
|
50eb79b797 | ||
|
|
dd66ab423e | ||
|
|
7600da9e6c | ||
|
|
a1300ad826 | ||
|
|
fea0c84f2f | ||
|
|
25fb9a6a54 | ||
|
|
baf1eb36e4 | ||
|
|
6c22f6b730 | ||
|
|
2071be71b1 | ||
|
|
9cf727affb | ||
|
|
5140d2419c | ||
|
|
d716e3bd57 | ||
|
|
02f302c8cf | ||
|
|
9ef860c58c | ||
|
|
702bb9ab89 | ||
|
|
a7e21b7c56 | ||
|
|
6b77d746e1 | ||
|
|
7e152743be | ||
|
|
0513ad381a | ||
|
|
b37dff78c1 | ||
|
|
103eb015c0 | ||
|
|
73519e9804 | ||
|
|
2867ac2637 | ||
|
|
3d0413417d | ||
|
|
56d50aec7c | ||
|
|
b1ee2de573 | ||
|
|
5d5b5a4242 | ||
|
|
c8ff4cae81 | ||
|
|
6104a20928 | ||
|
|
b87d0095dc | ||
|
|
4632c037e3 | ||
|
|
28c9edc49b | ||
|
|
614c8b3360 | ||
|
|
a4f289d5b5 | ||
|
|
75bdb75689 | ||
|
|
13f6f72bb7 | ||
|
|
af838a5d52 | ||
|
|
8091425c93 | ||
|
|
4c03aeaadd | ||
|
|
69ae2a0f03 | ||
|
|
7988b3f1b6 | ||
|
|
827a1d3802 | ||
|
|
0657f97bc5 | ||
|
|
6598d2eeae | ||
|
|
29225e440c | ||
|
|
231fd112f9 | ||
|
|
70a3d08fc4 | ||
|
|
c7771a763e | ||
|
|
6c1bdd15d6 | ||
|
|
9a6a7030e8 | ||
|
|
633171eda9 | ||
|
|
2acd355f8d | ||
|
|
73ff912a1f | ||
|
|
b9722ec356 | ||
|
|
f3f254e8ba | ||
|
|
f1e62884ba | ||
|
|
e18d096bd7 | ||
|
|
54a1d7e517 | ||
|
|
c6cce703b5 | ||
|
|
51f0bfd5ae | ||
|
|
f19e2665d3 | ||
|
|
a7c911213a | ||
|
|
96d441c29a | ||
|
|
41da2b1489 | ||
|
|
72dfeb60e2 | ||
|
|
b27acbe84f | ||
|
|
1b8701ee3d | ||
|
|
83d22bd1f6 | ||
|
|
861c6c226a | ||
|
|
b0bd6fc251 | ||
|
|
6643ceb141 | ||
|
|
16a75f3cbf | ||
|
|
ed8816500e | ||
|
|
5ef48eba53 | ||
|
|
ee48919fcc | ||
|
|
b359029baa | ||
|
|
d6a3425ec6 | ||
|
|
b0f19e41f2 | ||
|
|
c447bf4370 | ||
|
|
68328fdcd5 | ||
|
|
00dd4a5b56 | ||
|
|
ac555b905c | ||
|
|
5990382222 | ||
|
|
c7e670b85f | ||
|
|
86e88cf233 | ||
|
|
e47cbdc798 | ||
|
|
a5297cf7c3 | ||
|
|
32ffe00c48 | ||
|
|
8f8a3bc1c0 | ||
|
|
a038d4aad3 | ||
|
|
17c92b0a7a | ||
|
|
4eb91b8e5b | ||
|
|
ebcc04616c | ||
|
|
50dde26caf | ||
|
|
6fa73194d5 | ||
|
|
49c4458a25 | ||
|
|
02563b1911 | ||
|
|
54e89ec231 | ||
|
|
8074bcec5e | ||
|
|
4db805463e | ||
|
|
45dd8baf76 | ||
|
|
f6f92fd671 | ||
|
|
f2f41b4b85 | ||
|
|
db43c8cbed | ||
|
|
062f4d0529 | ||
|
|
48d6b3d84c | ||
|
|
aafa141509 | ||
|
|
d6ed36f134 | ||
|
|
14d2bc5415 | ||
|
|
36cebb89fe | ||
|
|
c8c0db5f21 | ||
|
|
c29132ab84 | ||
|
|
edbf195dff | ||
|
|
4fa1fa29ae | ||
|
|
6fbc88e2a0 | ||
|
|
87ff0e4ee2 | ||
|
|
847fdd28f7 | ||
|
|
01e71bb26c | ||
|
|
ce00b07d6b | ||
|
|
363a6cc4cd | ||
|
|
180af1f9a5 | ||
|
|
c03808607b | ||
|
|
6c604517d7 | ||
|
|
6802927d5c | ||
|
|
c0c0164a71 | ||
|
|
284a501487 | ||
|
|
909827f9ee | ||
|
|
293c1ff559 | ||
|
|
e95d2eea7f | ||
|
|
2e02e1affd | ||
|
|
77b454d1b2 | ||
|
|
8f15f09491 | ||
|
|
8d076e6525 | ||
|
|
133b43a521 | ||
|
|
af5bfc68cc | ||
|
|
0d8a08dbf1 | ||
|
|
1a4e52416f | ||
|
|
4dcdd51adb | ||
|
|
73dbbaaa23 | ||
|
|
d162c9a16d | ||
|
|
ce9f04ddd1 | ||
|
|
8f269fcad1 | ||
|
|
67b780c161 | ||
|
|
f4cd60dbb4 | ||
|
|
d0ba759e2c | ||
|
|
3f84674ae3 | ||
|
|
4e92d998eb | ||
|
|
3e05a7babe | ||
|
|
5940356ced | ||
|
|
cc71607cb8 | ||
|
|
405a099384 | ||
|
|
1ea2b16a8d | ||
|
|
f976a32c62 | ||
|
|
92dd14e77c | ||
|
|
3f2bb8a029 | ||
|
|
e51f7da2ee | ||
|
|
af320fb41e | ||
|
|
e2f55284cf | ||
|
|
8a45e47c4c | ||
|
|
4dd7110019 | ||
|
|
6da79937df | ||
|
|
881b147ab5 | ||
|
|
b583ea7360 | ||
|
|
d40bb9d13a | ||
|
|
688c125ec3 | ||
|
|
66c0809095 | ||
|
|
06cc962945 | ||
|
|
88760a8a81 | ||
|
|
aa4247d47b | ||
|
|
81b4fa2fbd | ||
|
|
7b688527d7 | ||
|
|
41aa17e389 | ||
|
|
84d939b69a | ||
|
|
5f690c8fae | ||
|
|
c811b1d642 | ||
|
|
50c851a04b | ||
|
|
60ba166da0 | ||
|
|
2dccd2a567 | ||
|
|
df75b91956 | ||
|
|
43b5729ddf | ||
|
|
e1051201ce | ||
|
|
410ffcdefa | ||
|
|
1f5d09b497 | ||
|
|
eb23b011d0 | ||
|
|
03d0f99e6c | ||
|
|
694c4505cd | ||
|
|
28e5ec7db6 | ||
|
|
fea912c676 | ||
|
|
7555420166 | ||
|
|
10c71dc8b9 | ||
|
|
530e4b3bb9 | ||
|
|
b6bc736eee | ||
|
|
fe84f70800 | ||
|
|
c77055a803 | ||
|
|
3b426fffa1 | ||
|
|
09dd330c44 | ||
|
|
782009ca67 | ||
|
|
e1f2905dbc | ||
|
|
3458214e46 | ||
|
|
dd6950d635 | ||
|
|
c3cb435cf4 | ||
|
|
0987bb4b63 | ||
|
|
6c4b78cfa8 | ||
|
|
75eea66ef7 | ||
|
|
251211e714 | ||
|
|
e313582726 | ||
|
|
a06189323f | ||
|
|
93f06f4469 | ||
|
|
6c973cf9a2 | ||
|
|
e393e2694c | ||
|
|
1645895629 | ||
|
|
ef51b5aacd | ||
|
|
905633199c | ||
|
|
4d289b8084 | ||
|
|
85a2a91729 | ||
|
|
947e3f8405 | ||
|
|
64a0be31b9 | ||
|
|
2098e71e79 | ||
|
|
4a24561f0b | ||
|
|
ad7deae634 | ||
|
|
df1dd156ed | ||
|
|
1a819d1063 | ||
|
|
a6d654980e | ||
|
|
2fae9f1746 | ||
|
|
5eb2064b63 | ||
|
|
7f433932f6 | ||
|
|
2e9301202d | ||
|
|
8bfaaa8337 | ||
|
|
175931c905 | ||
|
|
18f61eeeeb | ||
|
|
54b8f46097 | ||
|
|
372bf74334 | ||
|
|
f9f1724b36 | ||
|
|
cd51753d86 | ||
|
|
f227a5d1ff | ||
|
|
5ddcd8fea9 | ||
|
|
fe4e51b427 | ||
|
|
bd259695f1 | ||
|
|
e5eeaadf3c | ||
|
|
3aaf8c0544 | ||
|
|
76130df460 | ||
|
|
da6df4adde | ||
|
|
1ddccee9d3 | ||
|
|
48570b93a6 | ||
|
|
025b74f7c7 | ||
|
|
51043c29db | ||
|
|
553caf0d2c | ||
|
|
87e417c1a1 | ||
|
|
e95eb57666 | ||
|
|
3a9a817f67 | ||
|
|
277effbc04 | ||
|
|
9f102b5b85 | ||
|
|
642792b1c2 | ||
|
|
ef5af05366 | ||
|
|
439a4360b3 | ||
|
|
6ee4d2b394 | ||
|
|
321bff2cd5 | ||
|
|
d252076f75 | ||
|
|
26c9f5e773 | ||
|
|
466e7c47c6 | ||
|
|
eb3390224b | ||
|
|
adab48a862 | ||
|
|
11048e958a | ||
|
|
f87dbfe42e | ||
|
|
dd36d764b7 | ||
|
|
2b41b2d12b | ||
|
|
6f566fc406 | ||
|
|
9cd23041f3 | ||
|
|
00afea1c26 | ||
|
|
f5125db22b | ||
|
|
08d2d4c09b | ||
|
|
f14ee8d1bb | ||
|
|
d425f04462 | ||
|
|
c90b84b116 | ||
|
|
8da10bea0f | ||
|
|
9ec33349d5 | ||
|
|
556c3fc35b | ||
|
|
39180cad0e | ||
|
|
4402cae446 | ||
|
|
79af33ce68 | ||
|
|
a3380d8151 | ||
|
|
b58023ffa1 | ||
|
|
e3e6c33969 | ||
|
|
1fe7d754ed | ||
|
|
d39298874a | ||
|
|
b794cb03e1 | ||
|
|
c7f27e3c87 | ||
|
|
e86259d193 | ||
|
|
6ca1315df1 | ||
|
|
b807564e68 | ||
|
|
c091b78af6 | ||
|
|
e359627a36 | ||
|
|
37dceb3922 | ||
|
|
0c2d0f0ab7 | ||
|
|
2fb58dc372 | ||
|
|
f22a5b57f7 | ||
|
|
883924f1e8 | ||
|
|
11b8f6eb00 | ||
|
|
2c78daa2b0 | ||
|
|
02c0281379 | ||
|
|
e736d151a0 | ||
|
|
dcb3b835e4 | ||
|
|
e027188168 | ||
|
|
f6830a72ec | ||
|
|
ae3ae231d0 | ||
|
|
c4c090889c | ||
|
|
01570cabab | ||
|
|
d4dd40b364 | ||
|
|
4c6600039e | ||
|
|
f3d3725e39 | ||
|
|
21d90d4f4a | ||
|
|
2f2003c490 | ||
|
|
b98b8f9181 | ||
|
|
aab1aa08f0 | ||
|
|
e90011ea91 | ||
|
|
182b7f85f6 | ||
|
|
e1b3b51a8f | ||
|
|
23dd40e1a2 | ||
|
|
9af2fb9efe | ||
|
|
1a7bbea40c | ||
|
|
d87bc3c2f0 | ||
|
|
aec3f90f4d | ||
|
|
198dbe0117 | ||
|
|
19eccf461d | ||
|
|
ca96bc096f | ||
|
|
034957707a | ||
|
|
ce003df1ca | ||
|
|
63e2ca9905 | ||
|
|
9512351bc5 | ||
|
|
ce353e21ed | ||
|
|
fb61224892 | ||
|
|
f10942c112 | ||
|
|
62e806dc83 | ||
|
|
9831556bf7 | ||
|
|
9586d2f54c | ||
|
|
800f0a1edf | ||
|
|
2aed8b1bdf | ||
|
|
304ca9a172 | ||
|
|
a9974c36d0 | ||
|
|
d7fdb20ed5 | ||
|
|
6e4c20e3a6 | ||
|
|
704627190d | ||
|
|
a8075a956d | ||
|
|
ab1a8089de | ||
|
|
9c35850e30 | ||
|
|
55bb2e9be3 | ||
|
|
0033456148 | ||
|
|
ce60562f86 | ||
|
|
cceb3ebdde | ||
|
|
aad734db91 | ||
|
|
ad32d6ed76 | ||
|
|
713ccc8bb6 | ||
|
|
c1ebc6273f | ||
|
|
e08e3fbc09 | ||
|
|
e8326222de | ||
|
|
aff6cc9141 | ||
|
|
ec63738e5c | ||
|
|
dcd5ea5b91 | ||
|
|
d8c2bafa2c | ||
|
|
ae955d6d24 | ||
|
|
bce26daa76 | ||
|
|
b4542dd058 | ||
|
|
756913ce13 | ||
|
|
21fec5d3d1 | ||
|
|
72557b402d | ||
|
|
a1d4fac3d8 | ||
|
|
4acb728d29 | ||
|
|
7b249ac174 | ||
|
|
d90b82d5ce | ||
|
|
f350cdd7cc | ||
|
|
3e3ef5f0be | ||
|
|
c70c765bc7 | ||
|
|
a67d7e8610 | ||
|
|
2b4d8d160a | ||
|
|
3504682d15 | ||
|
|
e49e2ac11d | ||
|
|
3c2a7e1741 | ||
|
|
1ab82013f2 | ||
|
|
065cc78833 | ||
|
|
32aba95cdd | ||
|
|
eea17e30ab | ||
|
|
556b19bf28 | ||
|
|
15dbbaf497 | ||
|
|
f52fe2c0c0 | ||
|
|
fc1e6cc187 | ||
|
|
dff9e4fbb2 | ||
|
|
92aeea296b | ||
|
|
42bbf78a33 | ||
|
|
04ef72b73b | ||
|
|
e47a1c3779 | ||
|
|
ce09232ac7 | ||
|
|
0a3bf031ac | ||
|
|
e78c831950 | ||
|
|
e284637f4c | ||
|
|
97195d18a9 | ||
|
|
99af05cca8 | ||
|
|
29a34b9b95 | ||
|
|
30b1f27305 | ||
|
|
b2687dde17 | ||
|
|
a0ec63efa5 | ||
|
|
e1fca6fb5d | ||
|
|
0fcfcc0f88 | ||
|
|
1852320cca | ||
|
|
79e893e6f2 | ||
|
|
4232bc484d | ||
|
|
af2c18d5ea | ||
|
|
fadb579028 | ||
|
|
ed01d27700 | ||
|
|
09b9930667 | ||
|
|
657095d29a | ||
|
|
05277ab690 | ||
|
|
333b4efa28 | ||
|
|
adbdca59a9 | ||
|
|
2918f547d8 | ||
|
|
c52403ad33 | ||
|
|
2b343d0207 | ||
|
|
5363b1f11f | ||
|
|
b49efc9ae0 | ||
|
|
7fe77d7ff8 | ||
|
|
f54d9a7c69 | ||
|
|
9832ae4232 | ||
|
|
388bc52075 | ||
|
|
2c039a780e | ||
|
|
5c70426f61 | ||
|
|
d2fa0702bc | ||
|
|
530d3a7f83 | ||
|
|
f98272ec1e | ||
|
|
ba64c646ee | ||
|
|
528b7b7168 | ||
|
|
0fbdd463cb | ||
|
|
dd1dc3c6e8 | ||
|
|
4a3c559932 | ||
|
|
cc185b1d76 | ||
|
|
2ef45b0593 | ||
|
|
f79b9fa715 | ||
|
|
50baebbe77 | ||
|
|
749fefd640 | ||
|
|
b6ce0622a6 | ||
|
|
2e12764223 | ||
|
|
fc2acd077c | ||
|
|
e6c0a3dcfb | ||
|
|
962a5361ab | ||
|
|
a15ae048d3 | ||
|
|
f91edb6f99 | ||
|
|
3763c10f23 | ||
|
|
84f1110b9d | ||
|
|
6bb895f4c6 | ||
|
|
c4329d52b1 | ||
|
|
86ec6ab749 | ||
|
|
07235a8a6f | ||
|
|
e36e170f46 | ||
|
|
5f1e5885b7 | ||
|
|
f04818aaa8 | ||
|
|
2e1f7ff673 | ||
|
|
6d704ccf07 | ||
|
|
fef646d799 | ||
|
|
2f0b5c46a2 | ||
|
|
03a672aeea | ||
|
|
3294957eb6 | ||
|
|
4789965abd | ||
|
|
9735f7b1a9 | ||
|
|
0779620efd | ||
|
|
69675d1a04 | ||
|
|
57ed822ecb | ||
|
|
314feacb7c | ||
|
|
136b650bda | ||
|
|
65b685deca | ||
|
|
0865a0b6b0 | ||
|
|
79260bd695 | ||
|
|
1a062775d2 | ||
|
|
a855be143c | ||
|
|
5e07595538 | ||
|
|
5ed49bbc61 | ||
|
|
fa0c0e6134 | ||
|
|
f3b329dd28 | ||
|
|
496cff3ee1 | ||
|
|
0f93742804 | ||
|
|
7dd7fe1b6c | ||
|
|
bfcd8d392a | ||
|
|
004c1e1c8e | ||
|
|
99145db40b | ||
|
|
2569d6f81c | ||
|
|
dafa1487f9 | ||
|
|
743e0e4e1a | ||
|
|
8249e877df | ||
|
|
b308bd97e6 | ||
|
|
ae24dd87fa | ||
|
|
995eed36fd | ||
|
|
c4f94adb46 | ||
|
|
d4b3d3a460 | ||
|
|
6eb109c913 | ||
|
|
edb3a561eb | ||
|
|
c15b6135d5 | ||
|
|
a7a226fc49 | ||
|
|
76c3874ad8 | ||
|
|
c0eed541eb |
@@ -1,5 +1,11 @@
|
||||
name: Linux
|
||||
on: [push]
|
||||
on:
|
||||
push:
|
||||
branches:
|
||||
- "main"
|
||||
- "core-8-branch"
|
||||
tags:
|
||||
- "core-**"
|
||||
permissions:
|
||||
contents: read
|
||||
jobs:
|
||||
@@ -9,8 +15,6 @@ jobs:
|
||||
matrix:
|
||||
cfgopt:
|
||||
- ""
|
||||
- "CFLAGS=-DTCL_UTF_MAX=3"
|
||||
- "CFLAGS=-DTCL_NO_DEPRECATED=1"
|
||||
- "--disable-shared"
|
||||
- "--enable-symbols"
|
||||
- "--enable-symbols=mem"
|
||||
|
||||
@@ -1,5 +1,11 @@
|
||||
name: macOS
|
||||
on: [push]
|
||||
on:
|
||||
push:
|
||||
branches:
|
||||
- "main"
|
||||
- "core-8-branch"
|
||||
tags:
|
||||
- "core-**"
|
||||
permissions:
|
||||
contents: read
|
||||
jobs:
|
||||
|
||||
@@ -1,5 +1,11 @@
|
||||
name: Build Binaries
|
||||
on: [push]
|
||||
on:
|
||||
push:
|
||||
branches:
|
||||
- "main"
|
||||
- "core-8-branch"
|
||||
tags:
|
||||
- "core-**"
|
||||
permissions:
|
||||
contents: read
|
||||
jobs:
|
||||
|
||||
@@ -1,5 +1,11 @@
|
||||
name: Windows
|
||||
on: [push]
|
||||
on:
|
||||
push:
|
||||
branches:
|
||||
- "main"
|
||||
- "core-8-branch"
|
||||
tags:
|
||||
- "core-**"
|
||||
permissions:
|
||||
contents: read
|
||||
env:
|
||||
@@ -54,8 +60,6 @@ jobs:
|
||||
matrix:
|
||||
cfgopt:
|
||||
- ""
|
||||
- "CFLAGS=-DTCL_UTF_MAX=3"
|
||||
- "CFLAGS=-DTCL_NO_DEPRECATED=1"
|
||||
- "--disable-shared"
|
||||
- "--enable-symbols"
|
||||
- "--enable-symbols=mem"
|
||||
|
||||
-36
@@ -20,20 +20,12 @@ jobs:
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- name: "Linux/GCC/Shared: UTF_MAX=3"
|
||||
os: linux
|
||||
dist: focal
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- CFGOPT="CFLAGS=-DTCL_UTF_MAX=3"
|
||||
- name: "Linux/GCC/Shared: NO_DEPRECATED"
|
||||
os: linux
|
||||
dist: focal
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
|
||||
- name: "Linux/GCC/Static"
|
||||
os: linux
|
||||
dist: focal
|
||||
@@ -301,20 +293,6 @@ jobs:
|
||||
- touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h
|
||||
- choco install -y make zip
|
||||
- cd ${BUILD_DIR}
|
||||
- name: "Windows/GCC/Shared: UTF_MAX=3"
|
||||
os: windows
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=win
|
||||
- CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=3"
|
||||
before_install: *makepreinst
|
||||
- name: "Windows/GCC/Shared: NO_DEPRECATED"
|
||||
os: windows
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=win
|
||||
- CFGOPT="--enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1"
|
||||
before_install: *makepreinst
|
||||
- name: "Windows/GCC/Static"
|
||||
os: windows
|
||||
compiler: gcc
|
||||
@@ -343,20 +321,6 @@ jobs:
|
||||
env:
|
||||
- BUILD_DIR=win
|
||||
before_install: *makepreinst
|
||||
- name: "Windows/GCC-x86/Shared: UTF_MAX=3"
|
||||
os: windows
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=win
|
||||
- CFGOPT="CFLAGS=-DTCL_UTF_MAX=3"
|
||||
before_install: *makepreinst
|
||||
- name: "Windows/GCC-x86/Shared: NO_DEPRECATED"
|
||||
os: windows
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=win
|
||||
- CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
|
||||
before_install: *makepreinst
|
||||
- name: "Windows/GCC-x86/Static"
|
||||
os: windows
|
||||
compiler: gcc
|
||||
|
||||
-2634
File diff suppressed because it is too large
Load Diff
-2539
File diff suppressed because it is too large
Load Diff
-3629
File diff suppressed because it is too large
Load Diff
-4741
File diff suppressed because it is too large
Load Diff
-3349
File diff suppressed because it is too large
Load Diff
-4619
File diff suppressed because it is too large
Load Diff
-3822
File diff suppressed because it is too large
Load Diff
-5921
File diff suppressed because it is too large
Load Diff
-3796
File diff suppressed because it is too large
Load Diff
@@ -4650,7 +4650,7 @@ threading may still cause problems on AIX. (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 ---
|
||||
--- 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)
|
||||
@@ -4680,7 +4680,7 @@ 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 ---
|
||||
--- 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
|
||||
@@ -4705,7 +4705,7 @@ 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 ---
|
||||
--- Released 8.2.3, December 16, 1999
|
||||
|
||||
1999-09-14 (feature enhancement) added -start switch to regexp and regsub.
|
||||
|
||||
@@ -4762,7 +4762,7 @@ ExitThread to _endthreadex to prevent 4K mem leak (gravereaux)
|
||||
|
||||
1999-12-21 (bug fix) changed thread ids to longs (for 64bit systems)
|
||||
|
||||
--- Released 8.3b1, December 22, 1999 --- See ChangeLog for details ---
|
||||
--- 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)
|
||||
@@ -4788,7 +4788,7 @@ 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 ---
|
||||
--- Released 8.3b2, January 13, 2000
|
||||
|
||||
2000-01-14 (feature enhancement) clock format %Q added, clock scan updated
|
||||
|
||||
@@ -4827,7 +4827,7 @@ 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 ---
|
||||
--- 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
|
||||
@@ -4870,7 +4870,7 @@ tclLoadDyld.c dl type. (sanchez)
|
||||
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 ---
|
||||
--- Released 8.3.1, April 26, 2000
|
||||
|
||||
2000-04-26 (doc fix) updated/added documentation for many API's and
|
||||
commands (melski)
|
||||
@@ -4920,7 +4920,7 @@ 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 ---
|
||||
--- 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)
|
||||
@@ -4959,7 +4959,7 @@ 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 ---
|
||||
--- 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)
|
||||
@@ -5018,7 +5018,7 @@ 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 ---
|
||||
--- 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
|
||||
@@ -5076,7 +5076,7 @@ Update of READMEs.
|
||||
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 ---
|
||||
--- Released 8.3.3, April 6, 2001
|
||||
|
||||
2000-11-23 (new feature)[TIP 7] higher resolution timer on Windows (kenny)
|
||||
|
||||
@@ -5150,7 +5150,7 @@ system. This includes the addition of 'file normalize', 'file system',
|
||||
|
||||
* corrected several minor errors noted by Purify (hobbs)
|
||||
|
||||
--- Released 8.4a3, August 6, 2001 --- See ChangeLog for details ---
|
||||
--- Released 8.4a3, August 6, 2001
|
||||
|
||||
2001-06-27 (bug fix)[217987] corrected backslash substitution of non-ASCII
|
||||
characters. (hobbs, riefenstahl)
|
||||
@@ -5256,7 +5256,7 @@ bundles to standard .dylib dynamic libraries like on other unices.
|
||||
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 ---
|
||||
--- Released 8.3.4, October 19, 2001
|
||||
|
||||
2001-08-21 (bug fix)[219184] overagressive compilation of [catch] (sofer)
|
||||
|
||||
@@ -5282,8 +5282,6 @@ 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 ***
|
||||
@@ -5368,8 +5366,6 @@ of the Host: header value
|
||||
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)
|
||||
|
||||
@@ -5394,7 +5390,7 @@ 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.
|
||||
commands. See TIP for details.
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2002-02-22 (bug fix)[476537] Fix panic when loading shared library without
|
||||
@@ -5435,7 +5431,7 @@ of prior Tcl releases. Others will need to be reconciled.
|
||||
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 ---
|
||||
--- Released 8.4a4, March 5, 2002
|
||||
|
||||
2002-03-06 (new feature)[TIP 80] expanded [lsearch] options (wilkason, fellows)
|
||||
|
||||
@@ -5545,7 +5541,7 @@ options to configure (max)
|
||||
|
||||
2002-07-03 (bug fix)[577015] [catch] catches even compile errors (sofer)
|
||||
|
||||
--- Released 8.4b1, July 5, 2002 --- See ChangeLog for details ---
|
||||
--- Released 8.4b1, July 5, 2002
|
||||
|
||||
2002-07-08 (bug fix) restored compatibility of [viewFile] in tcltest (porter)
|
||||
|
||||
@@ -5583,7 +5579,7 @@ options to configure (max)
|
||||
Many internal bugs fixed.
|
||||
Considerable cleanup of the test suite.
|
||||
|
||||
--- Released 8.4b2, August 9, 2002 --- See ChangeLog for details ---
|
||||
--- Released 8.4b2, August 9, 2002
|
||||
|
||||
2002-08-20 (new feature) --enable-memdebug configure option (kupries)
|
||||
|
||||
@@ -5598,7 +5594,7 @@ Considerable cleanup of the test suite.
|
||||
|
||||
2002-09-02 (platfrom support) 64-bit compile on HP-11 (martin)
|
||||
|
||||
--- Released 8.4.0, September 10, 2002 --- See ChangeLog for details ---
|
||||
--- 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)
|
||||
@@ -5661,7 +5657,7 @@ 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 ---
|
||||
--- Released 8.4.1, October 22, 2002
|
||||
|
||||
2002-10-28 (bug fix)[627660] [package unknown] chaining for platform specifics
|
||||
|
||||
@@ -5754,7 +5750,7 @@ packages in multiple interps.
|
||||
|
||||
2003-02-27 (bug fix)[694232] stop [lsearch -start 0 {} x] segfault
|
||||
|
||||
--- Released 8.4.2, March 3, 2003 --- See ChangeLog for details ---
|
||||
--- Released 8.4.2, March 3, 2003
|
||||
|
||||
2003-03-06 (bug fix)[699042] Correct case-insensitive unicode string
|
||||
comparison in Tcl_UniCharNcasecmp
|
||||
@@ -5836,7 +5832,7 @@ 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 ---
|
||||
--- 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...)
|
||||
@@ -5877,7 +5873,7 @@ 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 ---
|
||||
--- Released 8.4.4, July 22, 2003
|
||||
|
||||
2003-07-23 (bug fix)[775976] fix registry compilation for VC7.
|
||||
|
||||
@@ -5923,7 +5919,7 @@ asked for writable events by the generic layer.
|
||||
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 ---
|
||||
--- Released 8.4.5, November 20, 2003
|
||||
|
||||
2003-12-02 (bug fix)[851747] object sharing fix in [binary scan]
|
||||
|
||||
@@ -5960,7 +5956,7 @@ various odd regexp "can't happen" bugs.
|
||||
|
||||
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 ---
|
||||
--- 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
|
||||
@@ -6046,7 +6042,7 @@ in this changeset (new minor version) rather than bug fixes:
|
||||
* [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 ---
|
||||
--- Released 8.5a1, March 3, 2004
|
||||
|
||||
2004-03-04 (new feature) registry package is [unload]able (thoyts)
|
||||
=> registry 1.1.4
|
||||
@@ -6070,7 +6066,7 @@ each command/interp validity before executing. (sofer)
|
||||
|
||||
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.
|
||||
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)
|
||||
@@ -6346,7 +6342,7 @@ 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 ---
|
||||
--- Released 8.5a2, December 7, 2004
|
||||
|
||||
2004-12-13 (bug fix)[1083082] encoding memory leaks (ade,porter)
|
||||
|
||||
@@ -6490,7 +6486,7 @@ Can support [load] from memory as well (steffen)
|
||||
|
||||
Documentation improvements [1075433,1085127,1117017,1124160,1149605,etc.]
|
||||
|
||||
--- Released 8.5a3, June 4, 2005 --- See ChangeLog for details ---
|
||||
--- Released 8.5a3, June 4, 2005
|
||||
|
||||
2005-06-06 (bug fix)[1213678] Windows/gcc: crash in stack.test (kenny)
|
||||
|
||||
@@ -6741,7 +6737,7 @@ removed (steffen)
|
||||
Documentation improvements [1211078,1190891,1292427,1277503,1104682,1359183,
|
||||
1415725,666770]
|
||||
|
||||
--- Released 8.5a4, April 27, 2006 --- See ChangeLog for details ---
|
||||
--- Released 8.5a4, April 27, 2006
|
||||
|
||||
2006-05-04 (bug fix)[1480509] srand() accept wide input (porter,afredd)
|
||||
|
||||
@@ -6837,7 +6833,7 @@ URL validity checking against RFC 2986 (hobbs)
|
||||
|
||||
2006-10-13 (platform support) get stack size on Darwin (steffen)
|
||||
|
||||
--- Released 8.5a5, October 20, 2006 --- See ChangeLog for details ---
|
||||
--- Released 8.5a5, October 20, 2006
|
||||
|
||||
2006-10-20 (configure change) Added autodetection for OS-supplied timezone
|
||||
files (max)
|
||||
@@ -6919,7 +6915,7 @@ upvar and namespace upvar (sofer)
|
||||
|
||||
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 ---
|
||||
--- Released 8.5a6, April 25, 2007
|
||||
|
||||
2007-04-30 (bug fix)[1705778] many valgrind-detected leaks corrected
|
||||
|
||||
@@ -7022,7 +7018,7 @@ project for Xcode 3.0 (steffen)
|
||||
(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 ---
|
||||
--- Released 8.5b1, September 26, 2007
|
||||
|
||||
2007-10-02 (bug fix)[1806422] proper [tcl::tm::path] autoload (porter)
|
||||
|
||||
@@ -7034,7 +7030,7 @@ on Windows to be larger than the default [interp recursionlimit] value
|
||||
|
||||
2007-10-25 (bug fix)[1726873] intermittent crash in threads (vasiljevic)
|
||||
|
||||
--- Released 8.5b2, October 26, 2007 --- See ChangeLog for details ---
|
||||
--- Released 8.5b2, October 26, 2007
|
||||
|
||||
2007-10-27 (bug fix)[1821159] fixed broken compile on x86_64 (sofer)
|
||||
|
||||
@@ -7070,7 +7066,7 @@ on Windows to be larger than the default [interp recursionlimit] value
|
||||
|
||||
Many significant documentation improvements (fellows, sofer)
|
||||
|
||||
--- Released 8.5b3, November 19, 2007 --- See ChangeLog for details ---
|
||||
--- Released 8.5b3, November 19, 2007
|
||||
|
||||
2007-11-20 (enhancement) string rep of dict has stable order (fellows)
|
||||
|
||||
@@ -7104,7 +7100,7 @@ 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 ---
|
||||
--- Released 8.5.0, December 20, 2007
|
||||
|
||||
2007-12-23 (bug fix)[1857126] restore backref support to regexps (hobbs)
|
||||
|
||||
@@ -7126,7 +7122,7 @@ Several documentation and release notes improvements
|
||||
|
||||
Several documentation and release notes improvements
|
||||
|
||||
--- Released 8.5.1, February 5, 2008 --- See ChangeLog for details ---
|
||||
--- Released 8.5.1, February 5, 2008
|
||||
|
||||
2008-02-06 (enhancement) [clock format] performance (kenny)
|
||||
|
||||
@@ -7187,7 +7183,7 @@ variables without "." added to customization hooks (kupries)
|
||||
|
||||
2008-03-27 clock tzdata updated to Olson's tzdata2008b (kenny)
|
||||
|
||||
--- Released 8.5.2, March 28, 2008 --- See ChangeLog for details ---
|
||||
--- Released 8.5.2, March 28, 2008
|
||||
|
||||
2008-03-30 (bug fix)[1783544] more robust TclIsNaN() (kenny,teterin)
|
||||
|
||||
@@ -7242,7 +7238,7 @@ variables without "." added to customization hooks (kupries)
|
||||
|
||||
2008-06-25 (bug fix)[1999119] Support TM packages in Safe Base (kupries)
|
||||
|
||||
--- Released 8.6a1, June 25, 2008 --- See ChangeLog for details ---
|
||||
--- Released 8.6a1, June 25, 2008
|
||||
|
||||
2008-06-29 (bug fix)[2004480] plug memory leaks (ade,porter,steffen)
|
||||
|
||||
@@ -7295,7 +7291,7 @@ in a deleted interp. (porter)
|
||||
|
||||
2008-08-21 (bug fix)[2065115] Restored ***= regexp functioning (hobbs,porter)
|
||||
|
||||
--- Released 8.6a2, August 25, 2008 --- See ChangeLog for details ---
|
||||
--- Released 8.6a2, August 25, 2008
|
||||
|
||||
2008-08-29 (bug fix)[2082299] Install TclOO header files (fellows)
|
||||
|
||||
@@ -7376,7 +7372,7 @@ Tcl_FSFileAttrStringsProc prototype. (nijtmans)
|
||||
|
||||
2008-10-10 (bug fix)[2155658] crash in oo method export (fellows)
|
||||
|
||||
--- Released 8.6a3, October 10, 2008 --- See ChangeLog for details ---
|
||||
--- Released 8.6a3, October 10, 2008
|
||||
|
||||
2008-10-13 (bug fix) Fix ability to join threads on 64-bit Windows (thoyts)
|
||||
|
||||
@@ -7446,7 +7442,7 @@ evaluation in extensions (sofer,kenny)
|
||||
|
||||
2008-12-18 (bug fix)[2444274] panic in long commands from {*} (goth,porter)
|
||||
|
||||
--- Released 8.6b1, December 19, 2008 --- See ChangeLog for details ---
|
||||
--- Released 8.6b1, December 19, 2008
|
||||
|
||||
2008-12-27 [TIP 234] Tcl_Zlib* interface revisions (fellows)
|
||||
*** INCOMPATIBILITY with interface of 8.6b1 ***
|
||||
@@ -7954,7 +7950,7 @@ memory with buffer backup (ferrieux)
|
||||
|
||||
Many more Tcl built-in command errors now set an -errorcode.
|
||||
|
||||
--- Released 8.6b2, August 8, 2011 --- See ChangeLog for details ---
|
||||
--- Released 8.6b2, August 8, 2011
|
||||
|
||||
2011-07-02 (bug fix)[3349507] correct double(1[string repeat 0 23]) (kenny)
|
||||
|
||||
@@ -8115,7 +8111,7 @@ 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 ---
|
||||
--- Released 8.6b3, September 18, 2012
|
||||
|
||||
2012-09-20 (enhancement) full Unicode support (nijtmans)
|
||||
=> dde 1.4.0
|
||||
@@ -8162,7 +8158,7 @@ Dropped support for OS X versions less than 10.4 (Tiger) (fellows)
|
||||
|
||||
2012-12-13 (bug fix) crash: [zlib gunzip $data -header noSuchNs::var] (porter)
|
||||
|
||||
--- Released 8.6.0, December 20, 2012 --- See ChangeLog for details ---
|
||||
--- Released 8.6.0, December 20, 2012
|
||||
|
||||
2012-12-22 (bug fix)[3598150] DString to Tcl_Obj memleak (afredd)
|
||||
|
||||
|
||||
+1
-2
@@ -28,9 +28,8 @@ opendir(
|
||||
if ((fd = open(myname, 0, 0)) == -1) {
|
||||
return NULL;
|
||||
}
|
||||
dirp = (DIR *) Tcl_Alloc(sizeof(DIR));
|
||||
dirp = (DIR *) Tcl_AttemptAlloc(sizeof(DIR));
|
||||
if (dirp == NULL) {
|
||||
/* unreachable? */
|
||||
close(fd);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
+5
-1
@@ -156,7 +156,11 @@ waitpid(
|
||||
goto waitAgain;
|
||||
}
|
||||
}
|
||||
waitPtr = (WaitInfo *) Tcl_Alloc(sizeof(WaitInfo));
|
||||
waitPtr = (WaitInfo *) Tcl_AttemptAlloc(sizeof(WaitInfo));
|
||||
if (!waitPtr) {
|
||||
errno = ENOMEM;
|
||||
return -1;
|
||||
}
|
||||
waitPtr->pid = result;
|
||||
waitPtr->status = status;
|
||||
waitPtr->nextPtr = deadList;
|
||||
|
||||
Regular → Executable
@@ -67,9 +67,6 @@ 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
|
||||
|
||||
+1
-1
@@ -187,7 +187,7 @@ except its \fIproc2\fR argument is of type \fBTcl_ObjCmdProc2\fR.
|
||||
typedef int \fBTcl_ObjCmdProc2\fR(
|
||||
void *\fIclientData\fR,
|
||||
Tcl_Interp *\fIinterp\fR,
|
||||
ptrdiff_t \fIobjc\fR,
|
||||
Tcl_Size \fIobjc\fR,
|
||||
Tcl_Obj *const \fIobjv\fR[]);
|
||||
.CE
|
||||
.PP
|
||||
|
||||
+2
-2
@@ -88,10 +88,10 @@ typedef int \fBTcl_CmdObjTraceProc\fR(
|
||||
typedef int \fBTcl_CmdObjTraceProc2\fR(
|
||||
\fBvoid *\fR \fIclientData\fR,
|
||||
\fBTcl_Interp\fR* \fIinterp\fR,
|
||||
ptrdiff_t \fIlevel\fR,
|
||||
Tcl_Size \fIlevel\fR,
|
||||
const char *\fIcommand\fR,
|
||||
\fBTcl_Command\fR \fIcommandToken\fR,
|
||||
ptrdiff_t \fIobjc\fR,
|
||||
Tcl_Size \fIobjc\fR,
|
||||
\fBTcl_Obj\fR *const \fIobjv\fR[]);
|
||||
.CE
|
||||
.PP
|
||||
|
||||
+11
-10
@@ -142,7 +142,8 @@ This saves the cost of allocating new memory and copying the string.
|
||||
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.
|
||||
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
|
||||
@@ -150,15 +151,15 @@ 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.
|
||||
\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
|
||||
|
||||
+1
-1
@@ -590,7 +590,7 @@ 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 8.7, the default profile is \fBtcl8\fR.
|
||||
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.
|
||||
|
||||
+1
-1
@@ -269,7 +269,7 @@ 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 "ptrdiff_t \&| int" *lenPtr out
|
||||
.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.
|
||||
|
||||
+2
-2
@@ -59,7 +59,7 @@ 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 "ptrdiff_t \&| int" *objcPtr in
|
||||
.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
|
||||
@@ -76,7 +76,7 @@ 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 "ptrdiff_t \&| int" *lengthPtr out
|
||||
.AP "Tcl_Size \&| int" *lengthPtr out
|
||||
Points to location where \fBTcl_ListObjLength\fR
|
||||
stores the length of the list.
|
||||
.AP Tcl_Size index in
|
||||
|
||||
+1
-1
@@ -133,7 +133,7 @@ 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
|
||||
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
|
||||
|
||||
+7
-5
@@ -406,8 +406,10 @@ 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.
|
||||
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
|
||||
@@ -416,9 +418,9 @@ eof (blocking mode).
|
||||
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.
|
||||
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
|
||||
|
||||
@@ -27,10 +27,6 @@ void
|
||||
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
|
||||
|
||||
@@ -45,9 +45,6 @@ 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 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
|
||||
The interpreter to transfer the result and return options from.
|
||||
.AP Tcl_Interp *targetInterp in
|
||||
|
||||
+2
-5
@@ -115,17 +115,14 @@ The index of the last Unicode character in the Unicode range to be
|
||||
returned as a new value. If negative, take all characters up to
|
||||
the last one available.
|
||||
.AP Tcl_Obj *objPtr in/out
|
||||
Points to a value to manipulate.
|
||||
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 "ptrdiff_t \&| int" *lengthPtr out
|
||||
.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 va_list argList in
|
||||
An argument list which must have been initialized using
|
||||
\fBva_start\fR, and cleared using \fBva_end\fR.
|
||||
.AP Tcl_Size limit in
|
||||
Maximum number of bytes to be appended.
|
||||
.AP "const char" *ellipsis in
|
||||
|
||||
+1
-1
@@ -188,7 +188,7 @@ 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
|
||||
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
|
||||
|
||||
+1
-1
@@ -69,7 +69,7 @@ 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
|
||||
.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
|
||||
|
||||
+16
-3
@@ -55,7 +55,9 @@ 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.
|
||||
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
|
||||
@@ -70,6 +72,17 @@ 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?...
|
||||
@@ -348,8 +361,8 @@ first words of a command that provides the interface for a \fBrefchan\fR.
|
||||
\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.
|
||||
.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
|
||||
|
||||
+15
-6
@@ -12,11 +12,12 @@
|
||||
.SH NAME
|
||||
close \- Close an open channel
|
||||
.SH SYNOPSIS
|
||||
\fBclose \fIchannelId\fR ?r(ead)|w(rite)?
|
||||
\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.
|
||||
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),
|
||||
@@ -49,12 +50,20 @@ When the last interpreter in which the channel is registered invokes
|
||||
.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.
|
||||
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, \fBclose\fR
|
||||
generates an error (similar to the \fBexec\fR 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" :
|
||||
@@ -95,7 +104,7 @@ proc withOpenFile {filename channelVar script} {
|
||||
}
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
file(n), open(n), socket(n), eof(n), Tcl_StandardChannels(3)
|
||||
chan(n), file(n), open(n), socket(n), eof(n), Tcl_StandardChannels(3)
|
||||
.SH KEYWORDS
|
||||
blocking, channel, close, nonblocking, half-close
|
||||
'\" Local Variables:
|
||||
|
||||
@@ -0,0 +1,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:
|
||||
@@ -493,6 +493,12 @@ the slot:
|
||||
.
|
||||
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.
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
'\"
|
||||
'\" 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.
|
||||
|
||||
+47
@@ -490,6 +490,29 @@ be discovered with \fBinfo class forward\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
|
||||
@@ -679,6 +702,30 @@ object named \fIobject\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
|
||||
|
||||
+13
-13
@@ -24,7 +24,7 @@ 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
|
||||
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
|
||||
@@ -49,33 +49,33 @@ between \fIfirst\fR and \fIlast\fR are simply deleted.
|
||||
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
|
||||
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
|
||||
% ledit lst end+1 end+1 h i
|
||||
a b c d e f g h i
|
||||
\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
|
||||
% ledit lst 2 3
|
||||
a b e f g h i
|
||||
\fBledit\fR lst 2 3
|
||||
\fI\(-> a b e f g h i\fR
|
||||
.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
|
||||
\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"
|
||||
|
||||
+111
-3
@@ -58,6 +58,7 @@ the auto-load mechanism defined below.
|
||||
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
|
||||
@@ -70,8 +71,30 @@ 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
|
||||
@@ -79,13 +102,18 @@ 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 TCLLIBPATH environment variable is
|
||||
\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
|
||||
@@ -104,6 +132,11 @@ the array \fBauto_index\fR; future calls to \fBauto_load\fR check for
|
||||
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
|
||||
.
|
||||
@@ -156,6 +189,7 @@ 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
|
||||
@@ -175,6 +209,7 @@ 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.
|
||||
@@ -197,14 +232,25 @@ 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
|
||||
.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
|
||||
@@ -215,19 +261,35 @@ 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
|
||||
@@ -235,6 +297,7 @@ 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
|
||||
@@ -248,18 +311,30 @@ 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
|
||||
@@ -275,37 +350,70 @@ 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 is "\\W".
|
||||
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 is "\\w".
|
||||
considered to be a word character. The default value is
|
||||
.QW "\\w" .
|
||||
.SH "SEE ALSO"
|
||||
env(n), info(n), re_syntax(n)
|
||||
.SH KEYWORDS
|
||||
|
||||
+7
-7
@@ -52,11 +52,11 @@ oo::class create ABC {
|
||||
|
||||
constructor {} {
|
||||
\fBlink\fR Foo
|
||||
# The method foo is now directly accessible as foo here
|
||||
# The method Foo is now directly accessible as Foo here
|
||||
\fBlink\fR {bar Foo}
|
||||
# The method foo is now directly accessible as bar
|
||||
# The method Foo is now directly accessible as bar
|
||||
\fBlink\fR {::ExternalCall Foo}
|
||||
# The method foo is now directly accessible in the global
|
||||
# The method Foo is now directly accessible in the global
|
||||
# namespace as ExternalCall
|
||||
}
|
||||
|
||||
@@ -71,13 +71,13 @@ oo::class create ABC {
|
||||
ABC create abc
|
||||
abc grill
|
||||
\fI\(-> Step 1:\fR
|
||||
\fI\(-> This is foo in ::abc\fR
|
||||
\fI\(-> This is Foo in ::abc\fR
|
||||
\fI\(-> Step 2:\fR
|
||||
\fI\(-> This is foo in ::abc\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
|
||||
\fI\(-> This is Foo in ::abc\fR
|
||||
.CE
|
||||
.PP
|
||||
This example shows that multiple linked commands can be made in a call to
|
||||
@@ -88,7 +88,7 @@ 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.
|
||||
# directly accessible within methods under their own names.
|
||||
}
|
||||
|
||||
method a {} {
|
||||
|
||||
+1
-1
@@ -16,7 +16,7 @@ lremove \- Remove elements from a list by index
|
||||
.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
|
||||
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,
|
||||
|
||||
+56
-49
@@ -11,73 +11,80 @@
|
||||
.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 \fR?(\fB..\fR|\fBto\fR)? \fIend\fR ??\fBby\fR? \fIstep\fR?
|
||||
|
||||
\fBlseq \fIStart \fBcount\fR \fICount\fR ??\fBby\fR? \fIStep\fR?
|
||||
\fBlseq \fIstart \fBcount\fR \fIcount\fR ??\fBby\fR? \fIstep\fR?
|
||||
|
||||
\fBlseq \fICount\fR ?\fBby \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 an inclusive range. The "count" option is used
|
||||
to define a count of the number of elements in the list. The short form with a
|
||||
single count value will create a range from 0 to count-1.
|
||||
|
||||
The numeric arguments, \fIStart\fR, \fIEnd\fR, \fIStep\fR, and \fICount\fR,
|
||||
can also be a valid expression. the lseq command will evaluate the expression
|
||||
parameters \fIstart\fR, \fIend\fR, and \fIstep\fR.
|
||||
The \fIoperation\fR argument
|
||||
.QW \fB..\fR
|
||||
or
|
||||
.QW \fBto\fR
|
||||
defines an inclusive range; if it is omitted, the range is exclusive.
|
||||
The \fBcount\fR option is used to define a count of the number of elements in
|
||||
the list.
|
||||
The \fIstep\fR (which may be preceded by \fBby\fR) is 1 if not provided.
|
||||
The short form with a
|
||||
single \fIcount\fR value will create a range from 0 to \fIcount\fR-1 (i.e.,
|
||||
\fIcount\fR values).
|
||||
.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 valid expression is a valid [expr] expression, however, the result
|
||||
must be numeric; a non-numeric string will result in an error.
|
||||
value; a non-numeric expression result will result in an error.
|
||||
|
||||
.SH EXAMPLES
|
||||
.CS
|
||||
.\"
|
||||
\fBlseq\fR 3
|
||||
\fI\(-> 0 1 2\fR
|
||||
|
||||
lseq 3
|
||||
\(-> 0 1 2
|
||||
\fBlseq\fR 3 0
|
||||
\fI\(-> 3 2 1 0\fR
|
||||
|
||||
lseq 3 0
|
||||
\(-> 3 2 1 0
|
||||
\fBlseq\fR 10 .. 1 by -2
|
||||
\fI\(-> 10 8 6 4 2\fR
|
||||
|
||||
lseq 10 .. 1 by -2
|
||||
\(-> 10 8 6 4 2
|
||||
set l [\fBlseq\fR 0 -5]
|
||||
\fI\(-> 0 -1 -2 -3 -4 -5\fR
|
||||
|
||||
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] {
|
||||
foreach i [\fBlseq\fR [llength $l]] {
|
||||
puts l($i)=[lindex $l $i]
|
||||
}
|
||||
\(-> l(5)=-5
|
||||
l(4)=-4
|
||||
l(3)=-3
|
||||
l(2)=-2
|
||||
l(1)=-1
|
||||
l(0)=0
|
||||
}
|
||||
\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
|
||||
|
||||
set i 17
|
||||
\(-> 17
|
||||
if {$i in [lseq 0 50]} { # equivalent to: (0 <= $i && $i < 50)
|
||||
puts "Ok"
|
||||
} else {
|
||||
puts "outside :("
|
||||
}
|
||||
\(-> Ok
|
||||
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 sqrs [lmap i [lseq 1 10] {expr $i*$i}]
|
||||
\(-> 1 4 9 16 25 36 49 64 81 100
|
||||
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"
|
||||
|
||||
+22
@@ -128,6 +128,28 @@ 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
|
||||
|
||||
+14
-1
@@ -11,7 +11,20 @@
|
||||
.SH NAME
|
||||
refchan \- command handler API of reflected channels
|
||||
.SH SYNOPSIS
|
||||
\fBcmdPrefix \fIoption\fR ?\fIarg arg ...\fR?
|
||||
.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
|
||||
|
||||
+3
-3
@@ -35,10 +35,10 @@ 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
|
||||
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:
|
||||
It will then return a canonical Tcl-list of the form:
|
||||
.PP
|
||||
.CS
|
||||
\fB0.095977 \(mcs/# 52095836 # 10419167 #/sec 5000.000 net-ms\fR
|
||||
@@ -85,7 +85,7 @@ 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.
|
||||
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
|
||||
|
||||
+12
-1
@@ -11,7 +11,18 @@
|
||||
.SH NAME
|
||||
transchan \- command handler API of channel transforms
|
||||
.SH SYNOPSIS
|
||||
\fBcmdPrefix \fIoption\fR ?\fIarg arg ...\fR?
|
||||
.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
|
||||
|
||||
@@ -84,15 +84,9 @@ typedef int celt; /* Type to hold chr, or NOCELT */
|
||||
#define NOCELT (-1) /* Celt value which is not valid chr */
|
||||
#define CHR(c) (UCHAR(c)) /* Turn char literal into chr literal */
|
||||
#define DIGITVAL(c) ((c)-'0') /* Turn chr digit into its value */
|
||||
#if TCL_UTF_MAX > 3
|
||||
#define CHRBITS 32 /* Bits in a chr; must not use sizeof */
|
||||
#define CHR_MIN 0x00000000 /* Smallest and largest chr; the value */
|
||||
#define CHR_MAX 0x10FFFF /* CHR_MAX-CHR_MIN+1 should fit in uchr */
|
||||
#else
|
||||
#define CHRBITS 16 /* Bits in a chr; must not use sizeof */
|
||||
#define CHR_MIN 0x0000 /* Smallest and largest chr; the value */
|
||||
#define CHR_MAX 0xFFFF /* CHR_MAX-CHR_MIN+1 should fit in uchr */
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Functions operating on chr.
|
||||
|
||||
+12
-12
@@ -146,7 +146,7 @@ declare 32 {
|
||||
}
|
||||
# Only available in Tcl 8.x, NULL in Tcl 9.0
|
||||
declare 33 {
|
||||
unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, int *numBytesPtr)
|
||||
unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, void *numBytesPtr)
|
||||
}
|
||||
declare 34 {
|
||||
int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr)
|
||||
@@ -173,7 +173,7 @@ declare 40 {
|
||||
const Tcl_ObjType *Tcl_GetObjType(const char *typeName)
|
||||
}
|
||||
declare 41 {
|
||||
char *TclGetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr)
|
||||
char *TclGetStringFromObj(Tcl_Obj *objPtr, void *lengthPtr)
|
||||
}
|
||||
declare 42 {
|
||||
void Tcl_InvalidateStringRep(Tcl_Obj *objPtr)
|
||||
@@ -188,7 +188,7 @@ declare 44 {
|
||||
}
|
||||
declare 45 {
|
||||
int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
|
||||
int *objcPtr, Tcl_Obj ***objvPtr)
|
||||
void *objcPtr, Tcl_Obj ***objvPtr)
|
||||
}
|
||||
declare 46 {
|
||||
int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index,
|
||||
@@ -196,7 +196,7 @@ declare 46 {
|
||||
}
|
||||
declare 47 {
|
||||
int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
|
||||
int *lengthPtr)
|
||||
void *lengthPtr)
|
||||
}
|
||||
declare 48 {
|
||||
int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first,
|
||||
@@ -881,12 +881,12 @@ declare 241 {
|
||||
void Tcl_SourceRCFile(Tcl_Interp *interp)
|
||||
}
|
||||
declare 242 {
|
||||
int TclSplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr,
|
||||
int TclSplitList(Tcl_Interp *interp, const char *listStr, void *argcPtr,
|
||||
const char ***argvPtr)
|
||||
}
|
||||
# Obsolete, use Tcl_FSSplitPath
|
||||
declare 243 {
|
||||
void TclSplitPath(const char *path, int *argcPtr, const char ***argvPtr)
|
||||
void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr)
|
||||
}
|
||||
# Removed in 9.0 (stub entry only)
|
||||
#declare 244 {
|
||||
@@ -1442,7 +1442,7 @@ declare 392 {
|
||||
}
|
||||
declare 393 {
|
||||
int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc,
|
||||
void *clientData, Tcl_Size stackSize, int flags)
|
||||
void *clientData, TCL_HASH_TYPE stackSize, int flags)
|
||||
}
|
||||
|
||||
# Introduced in 8.3.2
|
||||
@@ -1601,7 +1601,7 @@ declare 433 {
|
||||
|
||||
# introduced in 8.4a3
|
||||
declare 434 {
|
||||
Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr)
|
||||
Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, void *lengthPtr)
|
||||
}
|
||||
|
||||
# TIP#15 (math function introspection) dkf
|
||||
@@ -1702,7 +1702,7 @@ declare 460 {
|
||||
Tcl_Obj *Tcl_FSJoinPath(Tcl_Obj *listObj, Tcl_Size elements)
|
||||
}
|
||||
declare 461 {
|
||||
Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr)
|
||||
Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr)
|
||||
}
|
||||
declare 462 {
|
||||
int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, Tcl_Obj *secondPtr)
|
||||
@@ -1841,7 +1841,7 @@ declare 496 {
|
||||
Tcl_Obj *keyPtr)
|
||||
}
|
||||
declare 497 {
|
||||
int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr)
|
||||
int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, void *sizePtr)
|
||||
}
|
||||
declare 498 {
|
||||
int Tcl_DictObjFirst(Tcl_Interp *interp, Tcl_Obj *dictPtr,
|
||||
@@ -2270,7 +2270,7 @@ declare 603 {
|
||||
# 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)
|
||||
void *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv)
|
||||
}
|
||||
|
||||
# TIP#336 (manipulate the error line) dgp
|
||||
@@ -2468,7 +2468,7 @@ declare 648 {
|
||||
# TIP #568
|
||||
declare 649 {
|
||||
unsigned char *TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
int *numBytesPtr)
|
||||
void *numBytesPtr)
|
||||
}
|
||||
declare 650 {
|
||||
unsigned char *Tcl_GetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
|
||||
+40
-119
@@ -9,6 +9,7 @@
|
||||
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
|
||||
* Copyright (c) 1998-2000 by Scriptics Corporation.
|
||||
* Copyright (c) 2002 by Kevin B. Kenny. All rights reserved.
|
||||
* Copyright (c) 2021 by Nathan Coulter. All rights reserved.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
@@ -105,6 +106,9 @@ extern "C" {
|
||||
#include <stdio.h>
|
||||
#include <stddef.h>
|
||||
|
||||
|
||||
#define TCL_COMMENT(x)
|
||||
|
||||
#if defined(__GNUC__) && (__GNUC__ > 2)
|
||||
# if defined(_WIN32) && defined(__USE_MINGW_ANSI_STDIO) && __USE_MINGW_ANSI_STDIO
|
||||
# define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__MINGW_PRINTF_FORMAT, a, b)))
|
||||
@@ -208,10 +212,6 @@ extern "C" {
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#if !defined(CONST86) && !defined(TCL_NO_DEPRECATED)
|
||||
# define CONST86 const
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Make sure EXTERN isn't defined elsewhere.
|
||||
*/
|
||||
@@ -321,24 +321,12 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
|
||||
#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 */
|
||||
typedef ptrdiff_t Tcl_Size;
|
||||
#define TCL_SIZE_MAX PTRDIFF_MAX
|
||||
#define TCL_SIZE_MODIFIER TCL_T_MODIFIER
|
||||
|
||||
#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
|
||||
typedef struct __stat64 Tcl_StatBuf;
|
||||
#elif defined(__CYGWIN__)
|
||||
typedef struct {
|
||||
unsigned st_dev;
|
||||
@@ -465,28 +453,18 @@ typedef void (Tcl_ThreadCreateProc) (void *clientData);
|
||||
*/
|
||||
|
||||
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;
|
||||
|
||||
/*
|
||||
@@ -561,7 +539,7 @@ 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,
|
||||
ptrdiff_t level, const char *command, Tcl_Command commandInfo, ptrdiff_t objc,
|
||||
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,
|
||||
@@ -586,7 +564,7 @@ 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,
|
||||
ptrdiff_t objc, struct Tcl_Obj *const *objv);
|
||||
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, ...);
|
||||
@@ -608,10 +586,6 @@ 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
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
@@ -620,6 +594,10 @@ typedef void (Tcl_MainLoopProc) (void);
|
||||
* standard operations on objects of that type.
|
||||
*/
|
||||
|
||||
/* forward declaration */
|
||||
typedef struct Tcl_Obj Tcl_Obj;
|
||||
typedef struct Tcl_ObjInterface Tcl_ObjInterface;
|
||||
|
||||
typedef struct Tcl_ObjType {
|
||||
const char *name; /* Name of the type, e.g. "int". */
|
||||
Tcl_FreeInternalRepProc *freeIntRepProc;
|
||||
@@ -672,7 +650,7 @@ typedef union Tcl_ObjInternalRep { /* The internal representation: */
|
||||
* or both.
|
||||
*/
|
||||
|
||||
typedef struct Tcl_Obj {
|
||||
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
|
||||
@@ -692,7 +670,7 @@ typedef struct Tcl_Obj {
|
||||
* internal rep. NULL indicates the object has
|
||||
* no internal rep (has no type). */
|
||||
Tcl_ObjInternalRep internalRep; /* The internal representation: */
|
||||
} Tcl_Obj;
|
||||
};
|
||||
|
||||
|
||||
/*
|
||||
@@ -809,8 +787,8 @@ typedef struct {
|
||||
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 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];
|
||||
@@ -883,11 +861,7 @@ typedef struct Tcl_DString {
|
||||
* TCL_COMBINE Combine surrogates
|
||||
*/
|
||||
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
# define TCL_COMBINE 0x1000000
|
||||
#else
|
||||
# define TCL_COMBINE 0
|
||||
#endif
|
||||
#define TCL_COMBINE 0x1000000
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
* Flag values passed to Tcl_RecordAndEval, Tcl_EvalObj, Tcl_EvalObjv.
|
||||
@@ -1001,11 +975,7 @@ typedef struct Tcl_DString {
|
||||
*/
|
||||
|
||||
#ifndef TCL_HASH_TYPE
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
# define TCL_HASH_TYPE size_t
|
||||
#else
|
||||
# define TCL_HASH_TYPE unsigned
|
||||
#endif
|
||||
#define TCL_HASH_TYPE size_t
|
||||
#endif
|
||||
|
||||
typedef struct Tcl_HashKeyType Tcl_HashKeyType;
|
||||
@@ -1122,15 +1092,10 @@ struct Tcl_HashTable {
|
||||
* table. */
|
||||
Tcl_Size rebuildSize; /* Enlarge table when numEntries gets to be
|
||||
* this large. */
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
size_t mask; /* Mask value used in hashing function. */
|
||||
#endif
|
||||
int downShift; /* Shift count used in hashing function.
|
||||
* Designed to use high-order bits of
|
||||
* randomized keys. */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
int mask; /* Mask value used in hashing function. */
|
||||
#endif
|
||||
int keyType; /* Type of keys used in this table. It's
|
||||
* either TCL_CUSTOM_KEYS, TCL_STRING_KEYS,
|
||||
* TCL_ONE_WORD_KEYS, or an integer giving the
|
||||
@@ -1296,11 +1261,7 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, void *clientData);
|
||||
* interface.
|
||||
*/
|
||||
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
# define TCL_CLOSE2PROC NULL
|
||||
#else
|
||||
# define TCL_CLOSE2PROC ((void *) 1)
|
||||
#endif
|
||||
#define TCL_CLOSE2PROC NULL
|
||||
|
||||
/*
|
||||
* Channel version tag. This was introduced in 8.3.2/8.4.
|
||||
@@ -1850,12 +1811,10 @@ typedef struct Tcl_Parse {
|
||||
* *tokenPtr. */
|
||||
int errorType; /* One of the parsing error types defined
|
||||
* above. */
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
int incomplete; /* This field is set to 1 by Tcl_ParseCommand
|
||||
* if the command appears to be incomplete.
|
||||
* This information is used by
|
||||
* Tcl_CommandComplete. */
|
||||
#endif
|
||||
|
||||
/*
|
||||
* The fields below are intended only for the private use of the parser.
|
||||
@@ -1874,9 +1833,6 @@ typedef struct Tcl_Parse {
|
||||
* beginning of region where the error
|
||||
* occurred (e.g. the open brace if the close
|
||||
* brace is missing). */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
int incomplete;
|
||||
#endif
|
||||
Tcl_Token staticTokens[NUM_STATIC_TOKENS];
|
||||
/* Initial space for tokens for command. This
|
||||
* space should be large enough to accommodate
|
||||
@@ -1933,9 +1889,7 @@ typedef struct Tcl_EncodingType {
|
||||
* 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_STOPONERROR - Obsolete.
|
||||
* 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
|
||||
@@ -1960,25 +1914,20 @@ typedef struct Tcl_EncodingType {
|
||||
|
||||
#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_STOPONERROR 0x0 /* Not used any more */
|
||||
#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) */
|
||||
/*
|
||||
* 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
|
||||
/* Still being argued - For Tcl9, is the default strict? TODO */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
#define TCL_ENCODING_PROFILE_DEFAULT TCL_ENCODING_PROFILE_TCL8
|
||||
#else
|
||||
#define TCL_ENCODING_PROFILE_DEFAULT TCL_ENCODING_PROFILE_TCL8 /* STRICT? REPLACE? TODO */
|
||||
#endif
|
||||
#define TCL_ENCODING_PROFILE_DEFAULT TCL_ENCODING_PROFILE_STRICT
|
||||
|
||||
/*
|
||||
* The following definitions are the error codes returned by the conversion
|
||||
@@ -2020,11 +1969,7 @@ typedef struct Tcl_EncodingType {
|
||||
*/
|
||||
|
||||
#ifndef TCL_UTF_MAX
|
||||
# if TCL_MAJOR_VERSION > 8
|
||||
# define TCL_UTF_MAX 4
|
||||
# else
|
||||
# define TCL_UTF_MAX 3
|
||||
# endif
|
||||
#endif
|
||||
|
||||
/*
|
||||
@@ -2032,16 +1977,12 @@ typedef struct Tcl_EncodingType {
|
||||
* reflected in regcustom.h.
|
||||
*/
|
||||
|
||||
#if TCL_UTF_MAX > 3
|
||||
/*
|
||||
* int isn't 100% accurate as it should be a strict 4-byte value
|
||||
* (perhaps int32_t). ILP64/SILP64 systems may have troubles. The
|
||||
* size of this value must be reflected correctly in regcustom.h.
|
||||
*/
|
||||
/*
|
||||
* int isn't 100% accurate as it should be a strict 4-byte value
|
||||
* (perhaps int32_t). ILP64/SILP64 systems may have troubles. The
|
||||
* size of this value must be reflected correctly in regcustom.h.
|
||||
*/
|
||||
typedef int Tcl_UniChar;
|
||||
#else
|
||||
typedef unsigned short Tcl_UniChar;
|
||||
#endif
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
@@ -2213,6 +2154,7 @@ typedef int (Tcl_ArgvGenFuncProc)(void *clientData, Tcl_Interp *interp,
|
||||
#define TCL_IO_FAILURE ((Tcl_Size)-1)
|
||||
#define TCL_AUTO_LENGTH ((Tcl_Size)-1)
|
||||
#define TCL_INDEX_NONE ((Tcl_Size)-1)
|
||||
#define TCL_LENGTH_NONE ((Tcl_Size)-1)
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
@@ -2228,11 +2170,7 @@ typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp,
|
||||
* stubs tables.
|
||||
*/
|
||||
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
# define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *))
|
||||
#else
|
||||
# define TCL_STUB_MAGIC ((int) 0xFCA3BACF)
|
||||
#endif
|
||||
#define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *))
|
||||
|
||||
/*
|
||||
* The following function is required to be defined in all stubs aware
|
||||
@@ -2254,19 +2192,7 @@ void * TclStubCall(void *arg);
|
||||
#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
|
||||
#if 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), \
|
||||
@@ -2278,9 +2204,7 @@ void * TclStubCall(void *arg);
|
||||
TCL_STUB_MAGIC)
|
||||
#endif
|
||||
#else
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
# error "Please define -DUSE_TCL_STUBS"
|
||||
#elif TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
|
||||
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
|
||||
# define Tcl_InitStubs(interp, version, exact) \
|
||||
Tcl_PkgInitStubsCheck(interp, version, \
|
||||
(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
|
||||
@@ -2312,9 +2236,6 @@ EXTERN void Tcl_StaticLibrary(Tcl_Interp *interp,
|
||||
const char *prefix,
|
||||
Tcl_LibraryInitProc *initProc,
|
||||
Tcl_LibraryInitProc *safeInitProc);
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
# define Tcl_StaticPackage Tcl_StaticLibrary
|
||||
#endif
|
||||
EXTERN Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc);
|
||||
#ifdef _WIN32
|
||||
EXTERN const char *TclZipfs_AppHook(int *argc, wchar_t ***argv);
|
||||
@@ -2329,7 +2250,7 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
|
||||
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)
|
||||
#if defined(USE_TCL_STUBS)
|
||||
#define Tcl_SetPanicProc(panicProc) \
|
||||
TclInitStubTable(((const char *(*)(Tcl_PanicProc *))TclStubCall((void *)panicProc))(panicProc))
|
||||
#define Tcl_InitSubsystems() \
|
||||
@@ -2343,7 +2264,7 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
|
||||
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 *)) \
|
||||
(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) \
|
||||
|
||||
+250
-147
@@ -13,37 +13,102 @@
|
||||
#include "tclInt.h"
|
||||
#include "tclArithSeries.h"
|
||||
#include <assert.h>
|
||||
#include <math.h>
|
||||
|
||||
|
||||
/* -------------------------- ArithSeries object ---------------------------- */
|
||||
|
||||
/*
|
||||
* 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;
|
||||
}
|
||||
|
||||
#define ArithSeriesRepPtr(arithSeriesObjPtr) \
|
||||
(ArithSeries *) ((arithSeriesObjPtr)->internalRep.twoPtrValue.ptr1)
|
||||
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));
|
||||
}
|
||||
}
|
||||
|
||||
#define ArithSeriesIndexM(arithSeriesRepPtr, index) \
|
||||
((arithSeriesRepPtr)->isDouble ? \
|
||||
(((ArithSeriesDbl*)(arithSeriesRepPtr))->start+((index) * ((ArithSeriesDbl*)(arithSeriesRepPtr))->step)) \
|
||||
: \
|
||||
((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));
|
||||
}
|
||||
}
|
||||
|
||||
#define ArithSeriesGetInternalRep(objPtr, arithRepPtr) \
|
||||
do { \
|
||||
const Tcl_ObjInternalRep *irPtr; \
|
||||
irPtr = TclFetchInternalRep((objPtr), &tclArithSeriesType.objType); \
|
||||
(arithRepPtr) = irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL; \
|
||||
} while (0)
|
||||
static inline ArithSeries*
|
||||
ArithSeriesGetInternalRep(Tcl_Obj *objPtr)
|
||||
{
|
||||
const Tcl_ObjInternalRep *irPtr;
|
||||
irPtr = TclFetchInternalRep((objPtr), tclArithSeriesType);
|
||||
return irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL;
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
static inline int
|
||||
maxPrecision(double start, double end, double step)
|
||||
{
|
||||
// Find longest number of digits after the decimal point.
|
||||
int dp = Precision(step);
|
||||
int i = Precision(start);
|
||||
dp = i>dp ? i : dp;
|
||||
i = Precision(end);
|
||||
dp = i>dp ? i : dp;
|
||||
return dp;
|
||||
}
|
||||
|
||||
/*
|
||||
* Prototypes for procedures defined later in this file:
|
||||
*/
|
||||
|
||||
static void DupArithSeriesInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
|
||||
static void FreeArithSeriesInternalRep (Tcl_Obj *listPtr);
|
||||
static int SetArithSeriesFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
static void UpdateStringOfArithSeries (Tcl_Obj *arithSeriesObj);
|
||||
static Tcl_Obj *ArithSeriesObjStep(Tcl_Obj *arithSeriesPtr);
|
||||
static Tcl_Size ArithSeriesObjLength(Tcl_Obj *arithSeriesPtr);
|
||||
static void DupArithSeriesInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
|
||||
static void FreeArithSeriesInternalRep (Tcl_Obj *listPtr);
|
||||
static int SetArithSeriesFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
static void UpdateStringOfArithSeries (Tcl_Obj *arithSeriesObj);
|
||||
static Tcl_Obj* ArithSeriesObjStep(Tcl_Obj *arithSeriesPtr);
|
||||
static int ArithSeriesObjIndex(Tcl_Interp *, Tcl_Obj *,
|
||||
Tcl_Size index, Tcl_Obj **resultPtr);
|
||||
static int ArithSeriesObjLength(tclObjTypeInterfaceArgsListLength);
|
||||
static Tcl_Obj* ArithSeriesObjRange(tclObjTypeInterfaceArgsListRange);
|
||||
static Tcl_Obj* ArithSeriesObjReverse(tclObjTypeInterfaceArgsListReverse);
|
||||
static int ArithSeriesGetElements(tclObjTypeInterfaceArgsListAll);
|
||||
|
||||
/*
|
||||
* The structure below defines the arithmetic series Tcl object type by
|
||||
@@ -72,17 +137,39 @@ static Tcl_Size ArithSeriesObjLength(Tcl_Obj *arithSeriesPtr);
|
||||
* are valid and will be equivalent to the empty list.
|
||||
*/
|
||||
|
||||
const TclObjTypeWithAbstractList tclArithSeriesType = {
|
||||
{"arithseries", /* name */
|
||||
ObjInterface tclArithSeriesInterface = {
|
||||
1,
|
||||
{},
|
||||
{
|
||||
ArithSeriesGetElements,
|
||||
NULL,
|
||||
NULL,
|
||||
ArithSeriesObjIndex,
|
||||
NULL,
|
||||
NULL,
|
||||
ArithSeriesObjLength,
|
||||
ArithSeriesObjRange,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
ArithSeriesObjReverse,
|
||||
NULL,
|
||||
NULL,
|
||||
},
|
||||
};
|
||||
const ObjectType tclArithSeriesObjType = {
|
||||
"arithseries",
|
||||
FreeArithSeriesInternalRep, /* freeIntRepProc */
|
||||
DupArithSeriesInternalRep, /* dupIntRepProc */
|
||||
UpdateStringOfArithSeries, /* updateStringProc */
|
||||
SetArithSeriesFromAny, /* setFromAnyProc */
|
||||
TCL_OBJTYPE_V0_1(
|
||||
ArithSeriesObjLength
|
||||
)}
|
||||
2,
|
||||
(Tcl_ObjInterface *)&tclArithSeriesInterface
|
||||
};
|
||||
|
||||
MODULE_SCOPE const Tcl_ObjType *tclArithSeriesType
|
||||
= (Tcl_ObjType *)&tclArithSeriesObjType;
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -107,7 +194,7 @@ const TclObjTypeWithAbstractList tclArithSeriesType = {
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
static Tcl_WideInt
|
||||
ArithSeriesLen(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)
|
||||
ArithSeriesLenInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)
|
||||
{
|
||||
Tcl_WideInt len;
|
||||
|
||||
@@ -118,6 +205,18 @@ ArithSeriesLen(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)
|
||||
return (len < 0) ? -1 : len;
|
||||
}
|
||||
|
||||
static Tcl_WideInt
|
||||
ArithSeriesLenDbl(double start, double end, double step)
|
||||
{
|
||||
Tcl_WideInt len;
|
||||
|
||||
if (step == 0) {
|
||||
return 0;
|
||||
}
|
||||
len = ((end-start+step)/step);
|
||||
return (len < 0) ? -1 : len;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -140,10 +239,13 @@ static
|
||||
Tcl_Obj *
|
||||
NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_WideInt len)
|
||||
{
|
||||
Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step));
|
||||
Tcl_WideInt length;
|
||||
Tcl_Obj *arithSeriesObj;
|
||||
ArithSeries *arithSeriesRepPtr;
|
||||
|
||||
length = len>=0 ? len : -1;
|
||||
if (length < 0) length = -1;
|
||||
|
||||
TclNewObj(arithSeriesObj);
|
||||
|
||||
if (length <= 0) {
|
||||
@@ -159,7 +261,7 @@ NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_Wide
|
||||
arithSeriesRepPtr->elements = NULL;
|
||||
arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
|
||||
arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
|
||||
arithSeriesObj->typePtr = &tclArithSeriesType.objType;
|
||||
arithSeriesObj->typePtr = tclArithSeriesType;
|
||||
if (length > 0)
|
||||
Tcl_InvalidateStringRep(arithSeriesObj);
|
||||
|
||||
@@ -184,14 +286,20 @@ NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_Wide
|
||||
* None.
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static
|
||||
Tcl_Obj *
|
||||
NewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len)
|
||||
{
|
||||
Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step));
|
||||
Tcl_WideInt length;
|
||||
Tcl_Obj *arithSeriesObj;
|
||||
ArithSeriesDbl *arithSeriesRepPtr;
|
||||
|
||||
length = len>=0 ? len : -1;
|
||||
if (length < 0) {
|
||||
length = -1;
|
||||
}
|
||||
|
||||
TclNewObj(arithSeriesObj);
|
||||
|
||||
if (length <= 0) {
|
||||
@@ -205,11 +313,14 @@ NewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len)
|
||||
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 = &tclArithSeriesType.objType;
|
||||
if (length > 0)
|
||||
arithSeriesObj->typePtr = tclArithSeriesType;
|
||||
|
||||
if (length > 0) {
|
||||
Tcl_InvalidateStringRep(arithSeriesObj);
|
||||
}
|
||||
|
||||
return arithSeriesObj;
|
||||
}
|
||||
@@ -295,7 +406,7 @@ TclNewArithSeriesObj(
|
||||
{
|
||||
double dstart, dend, dstep;
|
||||
Tcl_WideInt start, end, step;
|
||||
Tcl_WideInt len;
|
||||
Tcl_WideInt len = -1;
|
||||
|
||||
if (startObj) {
|
||||
assignNumber(useDoubles, &start, &dstart, startObj);
|
||||
@@ -311,7 +422,7 @@ TclNewArithSeriesObj(
|
||||
dstep = step;
|
||||
}
|
||||
if (dstep == 0) {
|
||||
*arithSeriesObj = Tcl_NewObj();
|
||||
TclNewObj(*arithSeriesObj);
|
||||
return TCL_OK;
|
||||
}
|
||||
}
|
||||
@@ -337,9 +448,9 @@ TclNewArithSeriesObj(
|
||||
assert(dstep!=0);
|
||||
if (!lenObj) {
|
||||
if (useDoubles) {
|
||||
len = (dend - dstart + dstep)/dstep;
|
||||
len = ArithSeriesLenDbl(dstart, dend, dstep);
|
||||
} else {
|
||||
len = (end - start + step)/step;
|
||||
len = ArithSeriesLenInt(start, end, step);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -354,7 +465,7 @@ TclNewArithSeriesObj(
|
||||
}
|
||||
}
|
||||
|
||||
if (TCL_MAJOR_VERSION < 9 && len > ListSizeT_MAX) {
|
||||
if (len > TCL_SIZE_MAX) {
|
||||
Tcl_SetObjResult(
|
||||
interp,
|
||||
Tcl_NewStringObj("max length of a Tcl list exceeded", -1));
|
||||
@@ -395,10 +506,10 @@ ArithSeriesObjStep(
|
||||
ArithSeries *arithSeriesRepPtr;
|
||||
Tcl_Obj *stepObj;
|
||||
|
||||
if (arithSeriesObj->typePtr != &tclArithSeriesType.objType) {
|
||||
if (arithSeriesObj->typePtr != tclArithSeriesType) {
|
||||
Tcl_Panic("ArithSeriesObjStep called with a not ArithSeries Obj.");
|
||||
}
|
||||
arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesObj);
|
||||
arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
|
||||
if (arithSeriesRepPtr->isDouble) {
|
||||
TclNewDoubleObj(stepObj, ((ArithSeriesDbl*)(arithSeriesRepPtr))->step);
|
||||
} else {
|
||||
@@ -411,49 +522,43 @@ ArithSeriesObjStep(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclArithSeriesObjIndex --
|
||||
* ArithSeriesObjIndex --
|
||||
*
|
||||
* Returns the element with the specified index in the list
|
||||
* represented by the specified Arithmetic Sequence object.
|
||||
* If the index is out of range, NULL is returned.
|
||||
* Stores in **resultPtr the element with the specified index in the list
|
||||
* represented by the specified Arithmetic Sequence object. If the index
|
||||
* is out of range.
|
||||
*
|
||||
* Results:
|
||||
*
|
||||
* The element on success, NULL on index out of range.
|
||||
*
|
||||
* Side Effects:
|
||||
*
|
||||
* On success, the integer pointed by *element is modified.
|
||||
* TCL_OK on success, and TCL_ERROR if the index is out of range.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
Tcl_Obj *
|
||||
TclArithSeriesObjIndex(
|
||||
Tcl_Interp *interp,
|
||||
int
|
||||
ArithSeriesObjIndex(
|
||||
TCL_UNUSED(Tcl_Interp *),
|
||||
Tcl_Obj *arithSeriesObj,
|
||||
Tcl_WideInt index)
|
||||
Tcl_Size index,
|
||||
Tcl_Obj **resultPtr)
|
||||
{
|
||||
ArithSeries *arithSeriesRepPtr;
|
||||
|
||||
if (arithSeriesObj->typePtr != &tclArithSeriesType.objType) {
|
||||
Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj.");
|
||||
if (arithSeriesObj->typePtr != tclArithSeriesType) {
|
||||
Tcl_Panic("ArithSeriesObjIndex called with a not ArithSeries Obj.");
|
||||
}
|
||||
arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesObj);
|
||||
if (index < 0 || (Tcl_Size)index >= arithSeriesRepPtr->len) {
|
||||
if (interp) {
|
||||
Tcl_SetObjResult(interp,
|
||||
Tcl_ObjPrintf("index %" TCL_LL_MODIFIER "d is out of bounds 0 to %"
|
||||
TCL_LL_MODIFIER "d", index, (arithSeriesRepPtr->len-1)));
|
||||
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
|
||||
}
|
||||
return NULL;
|
||||
arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
|
||||
if (index < 0 || index >= arithSeriesRepPtr->len) {
|
||||
*resultPtr = Tcl_NewObj();
|
||||
return TCL_OK;
|
||||
}
|
||||
/* List[i] = Start + (Step * index) */
|
||||
if (arithSeriesRepPtr->isDouble) {
|
||||
return Tcl_NewDoubleObj(ArithSeriesIndexM(arithSeriesRepPtr, index));
|
||||
*resultPtr = Tcl_NewDoubleObj(ArithSeriesIndexDbl(arithSeriesRepPtr, index));
|
||||
return TCL_OK;
|
||||
} else {
|
||||
return Tcl_NewWideIntObj(ArithSeriesIndexM(arithSeriesRepPtr, index));
|
||||
*resultPtr = Tcl_NewWideIntObj(ArithSeriesIndexInt(arithSeriesRepPtr, index));
|
||||
return TCL_OK;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -474,11 +579,13 @@ TclArithSeriesObjIndex(
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
Tcl_Size ArithSeriesObjLength(Tcl_Obj *arithSeriesObj)
|
||||
int ArithSeriesObjLength(TCL_UNUSED(Tcl_Interp *),
|
||||
Tcl_Obj *arithSeriesObj, Tcl_Size *result)
|
||||
{
|
||||
ArithSeries *arithSeriesRepPtr = (ArithSeries*)
|
||||
arithSeriesObj->internalRep.twoPtrValue.ptr1;
|
||||
return arithSeriesRepPtr->len;
|
||||
*result = arithSeriesRepPtr->len;
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -541,18 +648,27 @@ DupArithSeriesInternalRep(
|
||||
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
|
||||
{
|
||||
ArithSeries *srcArithSeriesRepPtr =
|
||||
(ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1;
|
||||
ArithSeries *copyArithSeriesRepPtr;
|
||||
|
||||
(ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1;
|
||||
/*
|
||||
* Allocate a new ArithSeries structure. */
|
||||
|
||||
copyArithSeriesRepPtr = (ArithSeries*) Tcl_Alloc(sizeof(ArithSeries));
|
||||
*copyArithSeriesRepPtr = *srcArithSeriesRepPtr;
|
||||
copyArithSeriesRepPtr->elements = NULL;
|
||||
copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr;
|
||||
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 = &tclArithSeriesType.objType;
|
||||
copyPtr->typePtr = tclArithSeriesType;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -591,29 +707,47 @@ UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObj)
|
||||
char *elem, *p;
|
||||
Tcl_Obj *elemObj;
|
||||
Tcl_Size i;
|
||||
Tcl_WideInt length = 0;
|
||||
size_t slen;
|
||||
Tcl_Size length = 0;
|
||||
Tcl_Size slen;
|
||||
|
||||
/*
|
||||
* Pass 1: estimate space.
|
||||
*/
|
||||
for (i = 0; i < arithSeriesRepPtr->len; i++) {
|
||||
elemObj = TclArithSeriesObjIndex(NULL, arithSeriesObj, i);
|
||||
elem = Tcl_GetStringFromObj(elemObj, &slen);
|
||||
Tcl_DecrRefCount(elemObj);
|
||||
slen += 1; /* + 1 is for the space or the nul-term */
|
||||
length += slen;
|
||||
if (!arithSeriesRepPtr->isDouble) {
|
||||
for (i = 0; i < arithSeriesRepPtr->len; i++) {
|
||||
double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i);
|
||||
slen = d>0 ? log10(d)+1 : d<0 ? log10((0-d))+2 : 1;
|
||||
length += 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 ((length + strlen(tmp)) > TCL_SIZE_MAX) {
|
||||
break; // overflow
|
||||
}
|
||||
length += strlen(tmp);
|
||||
}
|
||||
}
|
||||
length += arithSeriesRepPtr->len; // Space for each separator
|
||||
|
||||
/*
|
||||
* Pass 2: generate the string repr.
|
||||
*/
|
||||
|
||||
p = Tcl_InitStringRep(arithSeriesObj, NULL, length);
|
||||
if (p == NULL) {
|
||||
Tcl_Panic("Unable to allocate string size %" TCL_Z_MODIFIER "u", length);
|
||||
}
|
||||
for (i = 0; i < arithSeriesRepPtr->len; i++) {
|
||||
elemObj = TclArithSeriesObjIndex(NULL, arithSeriesObj, i);
|
||||
ArithSeriesObjIndex(NULL, arithSeriesObj, i, &elemObj);
|
||||
elem = Tcl_GetStringFromObj(elemObj, &slen);
|
||||
strcpy(p, elem);
|
||||
if (((p - arithSeriesObj->bytes)+slen) > length) {
|
||||
break;
|
||||
}
|
||||
strncpy(p, elem, slen);
|
||||
p[slen] = ' ';
|
||||
p += slen+1;
|
||||
Tcl_DecrRefCount(elemObj);
|
||||
@@ -653,52 +787,6 @@ SetArithSeriesFromAny(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclArithSeriesObjCopy --
|
||||
*
|
||||
* Makes a "pure arithSeries" copy of an ArithSeries 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
|
||||
* arithSeries value as *arithSeriesObj does. The returned Tcl_Obj has a
|
||||
* refCount of zero. If *arithSeriesObj does not hold an arithSeries,
|
||||
* NULL is returned, and if interp is non-NULL, an error message is
|
||||
* recorded there.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
Tcl_Obj *
|
||||
TclArithSeriesObjCopy(
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */
|
||||
Tcl_Obj *arithSeriesObj) /* List object for which an element array is
|
||||
* to be returned. */
|
||||
{
|
||||
Tcl_Obj *copyPtr;
|
||||
ArithSeries *arithSeriesRepPtr;
|
||||
|
||||
ArithSeriesGetInternalRep(arithSeriesObj, arithSeriesRepPtr);
|
||||
if (NULL == arithSeriesRepPtr) {
|
||||
if (SetArithSeriesFromAny(interp, arithSeriesObj) != TCL_OK) {
|
||||
/* We know this is going to panic, but it's the message we want */
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
|
||||
TclNewObj(copyPtr);
|
||||
TclInvalidateStringRep(copyPtr);
|
||||
DupArithSeriesInternalRep(arithSeriesObj, copyPtr);
|
||||
return copyPtr;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -719,7 +807,7 @@ TclArithSeriesObjCopy(
|
||||
*/
|
||||
|
||||
Tcl_Obj *
|
||||
TclArithSeriesObjRange(
|
||||
ArithSeriesObjRange(
|
||||
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. */
|
||||
@@ -728,23 +816,36 @@ TclArithSeriesObjRange(
|
||||
ArithSeries *arithSeriesRepPtr;
|
||||
Tcl_Obj *startObj, *endObj, *stepObj;
|
||||
|
||||
ArithSeriesGetInternalRep(arithSeriesObj, arithSeriesRepPtr);
|
||||
arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
|
||||
|
||||
if (fromIdx == TCL_INDEX_NONE) {
|
||||
fromIdx = 0;
|
||||
}
|
||||
if (fromIdx > toIdx) {
|
||||
|
||||
if (fromIdx > toIdx ||
|
||||
(toIdx > arithSeriesRepPtr->len-1 &&
|
||||
fromIdx > arithSeriesRepPtr->len-1)) {
|
||||
Tcl_Obj *obj;
|
||||
TclNewObj(obj);
|
||||
return obj;
|
||||
}
|
||||
|
||||
startObj = TclArithSeriesObjIndex(interp, arithSeriesObj, fromIdx);
|
||||
if (fromIdx < 0) {
|
||||
fromIdx = 0;
|
||||
}
|
||||
if (toIdx < 0) {
|
||||
toIdx = 0;
|
||||
}
|
||||
if (toIdx > arithSeriesRepPtr->len-1) {
|
||||
toIdx = arithSeriesRepPtr->len-1;
|
||||
}
|
||||
|
||||
ArithSeriesObjIndex(interp, arithSeriesObj, fromIdx, &startObj);
|
||||
if (startObj == NULL) {
|
||||
return NULL;
|
||||
}
|
||||
Tcl_IncrRefCount(startObj);
|
||||
endObj = TclArithSeriesObjIndex(interp, arithSeriesObj, toIdx);
|
||||
ArithSeriesObjIndex(interp, arithSeriesObj, toIdx, &endObj);
|
||||
if (endObj == NULL) {
|
||||
return NULL;
|
||||
}
|
||||
@@ -778,15 +879,17 @@ TclArithSeriesObjRange(
|
||||
TclInvalidateStringRep(arithSeriesObj);
|
||||
|
||||
if (arithSeriesRepPtr->isDouble) {
|
||||
ArithSeriesDbl *arithSeriesDblRepPtr = (ArithSeriesDbl*)arithSeriesObj;
|
||||
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->len = (end-start+step)/step;
|
||||
arithSeriesDblRepPtr->precision = maxPrecision(start, end, step);
|
||||
arithSeriesDblRepPtr->len = ArithSeriesLenDbl(start, end, step);
|
||||
arithSeriesDblRepPtr->elements = NULL;
|
||||
|
||||
} else {
|
||||
@@ -797,7 +900,7 @@ TclArithSeriesObjRange(
|
||||
arithSeriesRepPtr->start = start;
|
||||
arithSeriesRepPtr->end = end;
|
||||
arithSeriesRepPtr->step = step;
|
||||
arithSeriesRepPtr->len = (end-start+step)/step;
|
||||
arithSeriesRepPtr->len = ArithSeriesLenInt(start, end, step);
|
||||
arithSeriesRepPtr->elements = NULL;
|
||||
}
|
||||
|
||||
@@ -811,7 +914,7 @@ TclArithSeriesObjRange(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclArithSeriesGetElements --
|
||||
* ArithSeriesGetElements --
|
||||
*
|
||||
* This function returns an (objc,objv) array of the elements in a list
|
||||
* object.
|
||||
@@ -838,7 +941,7 @@ TclArithSeriesObjRange(
|
||||
*/
|
||||
|
||||
int
|
||||
TclArithSeriesGetElements(
|
||||
ArithSeriesGetElements(
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */
|
||||
Tcl_Obj *objPtr, /* ArithSeries object for which an element
|
||||
* array is to be returned. */
|
||||
@@ -847,12 +950,12 @@ TclArithSeriesGetElements(
|
||||
Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of
|
||||
* pointers to the list's objects. */
|
||||
{
|
||||
if (TclHasInternalRep(objPtr,&tclArithSeriesType.objType)) {
|
||||
if (TclHasInternalRep(objPtr,tclArithSeriesType)) {
|
||||
ArithSeries *arithSeriesRepPtr;
|
||||
Tcl_Obj **objv;
|
||||
int i, objc;
|
||||
|
||||
ArithSeriesGetInternalRep(objPtr, arithSeriesRepPtr);
|
||||
arithSeriesRepPtr = ArithSeriesGetInternalRep(objPtr);
|
||||
objc = arithSeriesRepPtr->len;
|
||||
if (objc > 0) {
|
||||
if (arithSeriesRepPtr->elements) {
|
||||
@@ -872,7 +975,7 @@ TclArithSeriesGetElements(
|
||||
}
|
||||
arithSeriesRepPtr->elements = objv;
|
||||
for (i = 0; i < objc; i++) {
|
||||
objv[i] = TclArithSeriesObjIndex(interp, objPtr, i);
|
||||
ArithSeriesObjIndex(interp, objPtr, i, &objv[i]);
|
||||
if (objv[i] == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -899,7 +1002,7 @@ TclArithSeriesGetElements(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclArithSeriesObjReverse --
|
||||
* ArithSeriesObjReverse --
|
||||
*
|
||||
* Reverse the order of the ArithSeries value.
|
||||
* *arithSeriesObj must be known to be a valid list.
|
||||
@@ -916,7 +1019,7 @@ TclArithSeriesGetElements(
|
||||
*/
|
||||
|
||||
Tcl_Obj *
|
||||
TclArithSeriesObjReverse(
|
||||
ArithSeriesObjReverse(
|
||||
Tcl_Interp *interp, /* For error message(s) */
|
||||
Tcl_Obj *arithSeriesObj) /* List object to reverse. */
|
||||
{
|
||||
@@ -927,14 +1030,14 @@ TclArithSeriesObjReverse(
|
||||
double dstart, dend, dstep;
|
||||
int isDouble;
|
||||
|
||||
ArithSeriesGetInternalRep(arithSeriesObj, arithSeriesRepPtr);
|
||||
arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
|
||||
|
||||
isDouble = arithSeriesRepPtr->isDouble;
|
||||
len = arithSeriesRepPtr->len;
|
||||
|
||||
startObj = TclArithSeriesObjIndex(NULL, arithSeriesObj, (len-1));
|
||||
ArithSeriesObjIndex(NULL, arithSeriesObj, (len-1), &startObj);
|
||||
Tcl_IncrRefCount(startObj);
|
||||
endObj = TclArithSeriesObjIndex(NULL, arithSeriesObj, 0);
|
||||
ArithSeriesObjIndex(NULL, arithSeriesObj, 0, &endObj);
|
||||
Tcl_IncrRefCount(endObj);
|
||||
stepObj = ArithSeriesObjStep(arithSeriesObj);
|
||||
Tcl_IncrRefCount(stepObj);
|
||||
|
||||
@@ -30,19 +30,10 @@ typedef struct {
|
||||
double start;
|
||||
double end;
|
||||
double step;
|
||||
int precision;
|
||||
} ArithSeriesDbl;
|
||||
|
||||
|
||||
MODULE_SCOPE Tcl_Obj * TclArithSeriesObjCopy(Tcl_Interp *interp,
|
||||
Tcl_Obj *arithSeriesPtr);
|
||||
MODULE_SCOPE Tcl_Obj *TclArithSeriesObjIndex(Tcl_Interp *, Tcl_Obj *,
|
||||
Tcl_WideInt index);
|
||||
MODULE_SCOPE Tcl_Obj * TclArithSeriesObjRange(Tcl_Interp *interp,
|
||||
Tcl_Obj *arithSeriesPtr, Tcl_Size fromIdx, Tcl_Size toIdx);
|
||||
MODULE_SCOPE Tcl_Obj * TclArithSeriesObjReverse(Tcl_Interp *interp,
|
||||
Tcl_Obj *arithSeriesPtr);
|
||||
MODULE_SCOPE int TclArithSeriesGetElements(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr);
|
||||
MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp,
|
||||
Tcl_Obj **arithSeriesObj, int useDoubles,
|
||||
Tcl_Obj *startObj, Tcl_Obj *endObj,
|
||||
|
||||
@@ -857,7 +857,7 @@ CompileAssembleObj(
|
||||
* 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 */
|
||||
Tcl_Size sourceLen; /* Length of the source code in bytes */
|
||||
|
||||
/*
|
||||
* Get the expression ByteCode from the object. If it exists, make sure it
|
||||
@@ -2247,7 +2247,7 @@ static int
|
||||
GetListIndexOperand(
|
||||
AssemblyEnv* assemEnvPtr, /* Assembly environment */
|
||||
Tcl_Token** tokenPtrPtr, /* Current token from the parser */
|
||||
int* result) /* OUTPUT: Integer extracted from the token */
|
||||
int* result) /* OUTPUT: encoded index derived from the token */
|
||||
{
|
||||
CompileEnv* envPtr = assemEnvPtr->envPtr;
|
||||
/* Compilation environment */
|
||||
|
||||
+39
-20
@@ -805,7 +805,7 @@ Tcl_CreateInterp(void)
|
||||
iPtr->legacyFreeProc = (void (*) (void))-1;
|
||||
iPtr->errorLine = 0;
|
||||
iPtr->stubTable = &tclStubs;
|
||||
iPtr->objResultPtr = Tcl_NewObj();
|
||||
TclNewObj(iPtr->objResultPtr);
|
||||
Tcl_IncrRefCount(iPtr->objResultPtr);
|
||||
iPtr->handle = TclHandleCreate(iPtr);
|
||||
iPtr->globalNsPtr = NULL;
|
||||
@@ -890,7 +890,7 @@ Tcl_CreateInterp(void)
|
||||
iPtr->activeInterpTracePtr = NULL;
|
||||
iPtr->assocData = NULL;
|
||||
iPtr->execEnvPtr = NULL; /* Set after namespaces initialized. */
|
||||
iPtr->emptyObjPtr = Tcl_NewObj();
|
||||
TclNewObj(iPtr->emptyObjPtr);
|
||||
/* Another empty object. */
|
||||
Tcl_IncrRefCount(iPtr->emptyObjPtr);
|
||||
iPtr->threadId = Tcl_GetCurrentThread();
|
||||
@@ -954,7 +954,7 @@ Tcl_CreateInterp(void)
|
||||
* TIP #285, Script cancellation support.
|
||||
*/
|
||||
|
||||
iPtr->asyncCancelMsg = Tcl_NewObj();
|
||||
TclNewObj(iPtr->asyncCancelMsg);
|
||||
|
||||
cancelInfo = (CancelInfo *)Tcl_Alloc(sizeof(CancelInfo));
|
||||
cancelInfo->interp = interp;
|
||||
@@ -3298,7 +3298,7 @@ invokeObj2Command(
|
||||
Command *cmdPtr = (Command *) clientData;
|
||||
|
||||
if (objc > INT_MAX) {
|
||||
objc = TCL_INDEX_NONE; /* TODO - why? Should error, not truncate */
|
||||
return TclCommandWordLimitError(interp, objc);
|
||||
}
|
||||
if (cmdPtr->objProc != NULL) {
|
||||
result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
|
||||
@@ -3315,6 +3315,9 @@ static int cmdWrapper2Proc(void *clientData,
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
Command *cmdPtr = (Command *)clientData;
|
||||
if (objc > INT_MAX) {
|
||||
return TclCommandWordLimitError(interp, objc);
|
||||
}
|
||||
return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
|
||||
}
|
||||
|
||||
@@ -5164,17 +5167,17 @@ TclEvalEx(
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
const char *p, *next;
|
||||
const unsigned int minObjs = 20;
|
||||
const int minObjs = 20;
|
||||
Tcl_Obj **objv, **objvSpace;
|
||||
int *expand, *lines, *lineSpace;
|
||||
Tcl_Token *tokenPtr;
|
||||
int bytesLeft, expandRequested, code = TCL_OK;
|
||||
Tcl_Size commandLength;
|
||||
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_HASH_TYPE i, objectsUsed = 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
|
||||
@@ -5312,8 +5315,8 @@ TclEvalEx(
|
||||
Tcl_Size wordLine = line;
|
||||
const char *wordStart = parsePtr->commandStart;
|
||||
int *wordCLNext = clNext;
|
||||
unsigned int objectsNeeded = 0;
|
||||
unsigned int numWords = parsePtr->numWords;
|
||||
Tcl_Size objectsNeeded = 0;
|
||||
Tcl_Size numWords = parsePtr->numWords;
|
||||
|
||||
/*
|
||||
* Generate an array of objects for the words of the command.
|
||||
@@ -5332,6 +5335,8 @@ TclEvalEx(
|
||||
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.
|
||||
@@ -5381,12 +5386,22 @@ TclEvalEx(
|
||||
expandRequested = 1;
|
||||
expand[objectsUsed] = 1;
|
||||
|
||||
objectsNeeded += (numElements ? numElements : 1);
|
||||
additionalObjsCount = (numElements ? numElements : 1);
|
||||
|
||||
} else {
|
||||
expand[objectsUsed] = 0;
|
||||
objectsNeeded++;
|
||||
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);
|
||||
@@ -6137,7 +6152,11 @@ TclNREvalObjEx(
|
||||
*/
|
||||
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
listPtr = TclListObjCopy(interp, objPtr);
|
||||
listPtr = TclDuplicatePureObj(interp, objPtr, tclListType);
|
||||
if (!listPtr) {
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_IncrRefCount(listPtr);
|
||||
|
||||
if (word != INT_MIN) {
|
||||
@@ -7031,7 +7050,7 @@ ExprCeilFunc(
|
||||
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
|
||||
#ifdef ACCEPT_NAN
|
||||
if (code != TCL_OK) {
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
|
||||
|
||||
if (irPtr) {
|
||||
Tcl_SetObjResult(interp, objv[1]);
|
||||
@@ -7071,7 +7090,7 @@ ExprFloorFunc(
|
||||
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
|
||||
#ifdef ACCEPT_NAN
|
||||
if (code != TCL_OK) {
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
|
||||
|
||||
if (irPtr) {
|
||||
Tcl_SetObjResult(interp, objv[1]);
|
||||
@@ -7217,7 +7236,7 @@ ExprSqrtFunc(
|
||||
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
|
||||
#ifdef ACCEPT_NAN
|
||||
if (code != TCL_OK) {
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
|
||||
|
||||
if (irPtr) {
|
||||
Tcl_SetObjResult(interp, objv[1]);
|
||||
@@ -7271,7 +7290,7 @@ ExprUnaryFunc(
|
||||
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
|
||||
#ifdef ACCEPT_NAN
|
||||
if (code != TCL_OK) {
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
|
||||
|
||||
if (irPtr) {
|
||||
d = irPtr->doubleValue;
|
||||
@@ -7335,7 +7354,7 @@ ExprBinaryFunc(
|
||||
code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
|
||||
#ifdef ACCEPT_NAN
|
||||
if (code != TCL_OK) {
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
|
||||
|
||||
if (irPtr) {
|
||||
d1 = irPtr->doubleValue;
|
||||
@@ -7350,7 +7369,7 @@ ExprBinaryFunc(
|
||||
code = Tcl_GetDoubleFromObj(interp, objv[2], &d2);
|
||||
#ifdef ACCEPT_NAN
|
||||
if (code != TCL_OK) {
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
|
||||
|
||||
if (irPtr) {
|
||||
d2 = irPtr->doubleValue;
|
||||
@@ -7511,7 +7530,7 @@ ExprDoubleFunc(
|
||||
}
|
||||
if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
|
||||
#ifdef ACCEPT_NAN
|
||||
if (TclHasInternalRep(objv[1], &tclDoubleType.objType)) {
|
||||
if (TclHasInternalRep(objv[1], tclDoubleType)) {
|
||||
Tcl_SetObjResult(interp, objv[1]);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
+28
-86
@@ -381,35 +381,6 @@ Tcl_GetBytesFromObj(
|
||||
return baPtr->bytes;
|
||||
}
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED)
|
||||
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 */
|
||||
{
|
||||
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 {
|
||||
*numBytesPtr = (int) numBytes;
|
||||
}
|
||||
}
|
||||
return bytes;
|
||||
}
|
||||
#endif
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -509,7 +480,7 @@ MakeByteArray(
|
||||
|
||||
for (; src < srcEnd && dst < dstEnd; ) {
|
||||
int ch;
|
||||
int count = TclUtfToUCS4(src, &ch);
|
||||
int count = Tcl_UtfToUniChar(src, &ch);
|
||||
|
||||
if (ch > 255) {
|
||||
proper = 0;
|
||||
@@ -767,43 +738,14 @@ TclAppendBytesToByteArray(
|
||||
}
|
||||
needed = byteArrayPtr->used + len;
|
||||
if (needed > byteArrayPtr->allocated) {
|
||||
ByteArray *ptr = NULL;
|
||||
|
||||
/*
|
||||
* Try to allocate double the total space that is needed.
|
||||
*/
|
||||
|
||||
Tcl_Size attempt;
|
||||
|
||||
/* Make sure we do not wrap when doubling */
|
||||
if (needed <= (BYTEARRAY_MAX_LEN - needed)) {
|
||||
attempt = 2 * needed;
|
||||
ptr = (ByteArray *) Tcl_AttemptRealloc(byteArrayPtr,
|
||||
BYTEARRAY_SIZE(attempt));
|
||||
}
|
||||
|
||||
if (ptr == NULL) {
|
||||
/*
|
||||
* Try to allocate double the increment that is needed.
|
||||
* (Originally TCL_MIN_GROWTH was added as well but that would
|
||||
* need one more separate overflow check so forget it.)
|
||||
*/
|
||||
if (len <= (BYTEARRAY_MAX_LEN - needed)) {
|
||||
attempt = needed + len;
|
||||
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;
|
||||
Tcl_Size newCapacity;
|
||||
byteArrayPtr =
|
||||
(ByteArray *)TclReallocElemsEx(byteArrayPtr,
|
||||
needed,
|
||||
1,
|
||||
offsetof(ByteArray, bytes),
|
||||
&newCapacity);
|
||||
byteArrayPtr->allocated = newCapacity;
|
||||
SET_BYTEARRAY(irPtr, byteArrayPtr);
|
||||
}
|
||||
|
||||
@@ -870,7 +812,7 @@ BinaryFormatCmd(
|
||||
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
|
||||
Tcl_Size count; /* Count associated with current format
|
||||
* character. */
|
||||
int flags; /* Format field flags */
|
||||
const char *format; /* Pointer to current position in format
|
||||
@@ -1383,7 +1325,7 @@ BinaryScanCmd(
|
||||
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
|
||||
Tcl_Size count; /* Count associated with current format
|
||||
* character. */
|
||||
int flags; /* Format field flags */
|
||||
const char *format; /* Pointer to current position in format
|
||||
@@ -1795,14 +1737,14 @@ GetFormatSpec(
|
||||
(*formatPtr)++;
|
||||
*countPtr = BINARY_ALL;
|
||||
} else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */
|
||||
unsigned long count;
|
||||
unsigned long long count;
|
||||
|
||||
errno = 0;
|
||||
count = strtoul(*formatPtr, (char **) formatPtr, 10);
|
||||
if (errno || (count > (unsigned long) INT_MAX)) {
|
||||
*countPtr = INT_MAX;
|
||||
count = strtoull(*formatPtr, (char **) formatPtr, 10);
|
||||
if (errno || (count > TCL_SIZE_MAX)) {
|
||||
*countPtr = TCL_SIZE_MAX;
|
||||
} else {
|
||||
*countPtr = (int) count;
|
||||
*countPtr = count;
|
||||
}
|
||||
} else {
|
||||
*countPtr = BINARY_NOCOUNT;
|
||||
@@ -2030,7 +1972,7 @@ FormatNumber(
|
||||
*/
|
||||
|
||||
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType.objType);
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, tclDoubleType);
|
||||
if (irPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -2050,7 +1992,7 @@ FormatNumber(
|
||||
*/
|
||||
|
||||
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType.objType);
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, tclDoubleType);
|
||||
|
||||
if (irPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
@@ -2590,7 +2532,7 @@ BinaryDecodeHex(
|
||||
if (pure) {
|
||||
ucs4 = c;
|
||||
} else {
|
||||
TclUtfToUCS4((const char *)(data - 1), &ucs4);
|
||||
Tcl_UtfToUniChar((const char *)(data - 1), &ucs4);
|
||||
}
|
||||
TclDecrRefCount(resultObj);
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
@@ -2638,11 +2580,11 @@ BinaryEncode64(
|
||||
{
|
||||
Tcl_Obj *resultObj;
|
||||
unsigned char *data, *limit;
|
||||
int maxlen = 0;
|
||||
Tcl_Size maxlen = 0;
|
||||
const char *wrapchar = "\n";
|
||||
Tcl_Size wrapcharlen = 1;
|
||||
int i, index, size, outindex = 0, purewrap = 1;
|
||||
Tcl_Size offset, count = 0;
|
||||
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 };
|
||||
|
||||
@@ -2658,7 +2600,7 @@ BinaryEncode64(
|
||||
}
|
||||
switch (index) {
|
||||
case OPT_MAXLEN:
|
||||
if (Tcl_GetIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
|
||||
if (Tcl_GetSizeIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (maxlen < 0) {
|
||||
@@ -2764,12 +2706,12 @@ BinaryEncodeUu(
|
||||
{
|
||||
Tcl_Obj *resultObj;
|
||||
unsigned char *data, *start, *cursor;
|
||||
int rawLength, i, bits, index;
|
||||
int i, bits, index;
|
||||
unsigned int n;
|
||||
int lineLength = 61;
|
||||
const unsigned char SingleNewline[] = { UCHAR('\n') };
|
||||
const unsigned char *wrapchar = SingleNewline;
|
||||
Tcl_Size j, offset, count = 0, wrapcharlen = sizeof(SingleNewline);
|
||||
Tcl_Size j, rawLength, offset, count = 0, wrapcharlen = sizeof(SingleNewline);
|
||||
enum { OPT_MAXLEN, OPT_WRAPCHAR };
|
||||
static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };
|
||||
|
||||
@@ -2859,7 +2801,7 @@ BinaryEncodeUu(
|
||||
*/
|
||||
|
||||
while (offset < count) {
|
||||
int lineLen = count - offset;
|
||||
Tcl_Size lineLen = count - offset;
|
||||
|
||||
if (lineLen > rawLength) {
|
||||
lineLen = rawLength;
|
||||
@@ -3055,7 +2997,7 @@ BinaryDecodeUu(
|
||||
if (pure) {
|
||||
ucs4 = c;
|
||||
} else {
|
||||
TclUtfToUCS4((const char *)(data - 1), &ucs4);
|
||||
Tcl_UtfToUniChar((const char *)(data - 1), &ucs4);
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"invalid uuencode character \"%c\" (U+%06X) at position %"
|
||||
@@ -3230,7 +3172,7 @@ BinaryDecode64(
|
||||
* of a multi-byte character. */
|
||||
|
||||
/* Safe because we know data is NUL-terminated */
|
||||
TclUtfToUCS4((const char *)(data - 1), &ucs4);
|
||||
Tcl_UtfToUniChar((const char *)(data - 1), &ucs4);
|
||||
}
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
|
||||
@@ -16,6 +16,7 @@
|
||||
*/
|
||||
|
||||
#include "tclInt.h"
|
||||
#include <assert.h>
|
||||
|
||||
#define FALSE 0
|
||||
#define TRUE 1
|
||||
@@ -1233,6 +1234,148 @@ TclDumpMemoryInfo(
|
||||
|
||||
#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;
|
||||
}
|
||||
|
||||
/*
|
||||
*---------------------------------------------------------------------------
|
||||
*
|
||||
|
||||
+1
-1
@@ -433,7 +433,7 @@ ClockGetdatefieldsObjCmd(
|
||||
* that it isn't.
|
||||
*/
|
||||
|
||||
if (TclHasInternalRep(objv[1], &tclBignumType.objType)) {
|
||||
if (TclHasInternalRep(objv[1], tclBignumType)) {
|
||||
Tcl_SetObjResult(interp, lit[LIT_INTEGER_VALUE_TOO_LARGE]);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
+53
-31
@@ -17,7 +17,6 @@
|
||||
#ifdef _WIN32
|
||||
# include "tclWinInt.h"
|
||||
#endif
|
||||
#include "tclArithSeries.h"
|
||||
|
||||
/*
|
||||
* The state structure used by [foreach]. Note that the actual structure has
|
||||
@@ -27,9 +26,9 @@
|
||||
|
||||
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. */
|
||||
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. */
|
||||
@@ -435,11 +434,7 @@ EncodingConvertParseOptions (
|
||||
Tcl_Encoding encoding;
|
||||
Tcl_Obj *dataObj;
|
||||
Tcl_Obj *failVarObj;
|
||||
#if TCL_MAJOR_VERSION > 8 || defined(TCL_NO_DEPRECATED)
|
||||
int profile = TCL_ENCODING_PROFILE_TCL8; /* TODO - default for Tcl9? */
|
||||
#else
|
||||
int profile = TCL_ENCODING_PROFILE_TCL8;
|
||||
#endif
|
||||
int profile = TCL_ENCODING_PROFILE_STRICT;
|
||||
|
||||
/*
|
||||
* Possible combinations:
|
||||
@@ -2329,7 +2324,7 @@ StoreStatData(
|
||||
unsigned short mode;
|
||||
|
||||
if (varName == NULL) {
|
||||
result = Tcl_NewObj();
|
||||
TclNewObj(result);
|
||||
Tcl_IncrRefCount(result);
|
||||
#define DOBJPUT(key, objValue) \
|
||||
Tcl_DictObjPut(NULL, result, \
|
||||
@@ -2360,8 +2355,6 @@ StoreStatData(
|
||||
}
|
||||
|
||||
/*
|
||||
* 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.
|
||||
@@ -2393,9 +2386,15 @@ StoreStatData(
|
||||
#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("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));
|
||||
@@ -2733,7 +2732,8 @@ EachloopCmd(
|
||||
{
|
||||
int numLists = (objc-2) / 2;
|
||||
struct ForeachState *statePtr;
|
||||
int i, j, result;
|
||||
int i, result;
|
||||
Tcl_Size j;
|
||||
|
||||
if (objc < 4 || (objc%2 != 0)) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv,
|
||||
@@ -2787,13 +2787,18 @@ EachloopCmd(
|
||||
for (i=0 ; i<numLists ; i++) {
|
||||
/* List */
|
||||
/* Variables */
|
||||
statePtr->vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);
|
||||
if (statePtr->vCopyList[i] == NULL) {
|
||||
statePtr->vCopyList[i] = TclDuplicatePureObj(
|
||||
interp, objv[1+i*2], tclListType);
|
||||
if (!statePtr->vCopyList[i]) {
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
TclListObjLengthM(NULL, statePtr->vCopyList[i],
|
||||
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",
|
||||
@@ -2808,24 +2813,34 @@ EachloopCmd(
|
||||
&statePtr->varcList[i], &statePtr->varvList[i]);
|
||||
|
||||
/* Values */
|
||||
if (TclHasInternalRep(objv[2+i*2],&tclArithSeriesType.objType)) {
|
||||
/* Special case for Arith Series */
|
||||
statePtr->aCopyList[i] = TclArithSeriesObjCopy(interp, objv[2+i*2]);
|
||||
if (TclObjectHasInterface(objv[2+i*2], list, length)) {
|
||||
int status;
|
||||
statePtr->aCopyList[i] = Tcl_DuplicateObj(objv[2+i*2]);
|
||||
Tcl_IncrRefCount(statePtr->aCopyList[i]);
|
||||
if (statePtr->aCopyList[i] == NULL) {
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
/* Don't compute values here, wait until the last moment */
|
||||
statePtr->argcList[i] = ABSTRACTLIST_PROC(statePtr->aCopyList[i], lengthProc)(statePtr->aCopyList[i]);
|
||||
} else {
|
||||
/* List values */
|
||||
statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
|
||||
if (statePtr->aCopyList[i] == NULL) {
|
||||
TclObjectDispatchNoDefault(interp, status, statePtr->aCopyList[i], list,
|
||||
length, interp, statePtr->aCopyList[i], &statePtr->argcList[i]);
|
||||
if (status != TCL_OK) {
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
TclListObjGetElementsM(NULL, statePtr->aCopyList[i],
|
||||
} else {
|
||||
/* List values */
|
||||
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];
|
||||
@@ -2887,8 +2902,12 @@ ForeachLoopStep(
|
||||
break;
|
||||
case TCL_OK:
|
||||
if (statePtr->resultList != NULL) {
|
||||
Tcl_ListObjAppendElement(interp, statePtr->resultList,
|
||||
Tcl_GetObjResult(interp));
|
||||
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:
|
||||
@@ -2950,12 +2969,15 @@ ForeachAssignments(
|
||||
Tcl_Obj *valuePtr, *varValuePtr;
|
||||
|
||||
for (i=0 ; i<statePtr->numLists ; i++) {
|
||||
int isarithseries = TclHasInternalRep(statePtr->aCopyList[i],&tclArithSeriesType.objType);
|
||||
TCL_UNUSEDVAR(int status);
|
||||
int hasindexinterface = TclObjectHasInterface(
|
||||
statePtr->aCopyList[i], list, index);
|
||||
for (v=0 ; v<statePtr->varcList[i] ; v++) {
|
||||
k = statePtr->index[i]++;
|
||||
if (k < statePtr->argcList[i]) {
|
||||
if (isarithseries) {
|
||||
valuePtr = TclArithSeriesObjIndex(interp, statePtr->aCopyList[i], k);
|
||||
if (hasindexinterface) {
|
||||
TclObjectDispatchNoDefault(interp, status, statePtr->aCopyList[i], list,
|
||||
index, interp, statePtr->aCopyList[i], k, &valuePtr);
|
||||
if (valuePtr == NULL) {
|
||||
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
|
||||
"\n (setting %s loop variable \"%s\")",
|
||||
|
||||
+331
-125
@@ -712,7 +712,7 @@ InfoCommandsCmd(
|
||||
if (entryPtr != NULL) {
|
||||
if (specificNsInPattern) {
|
||||
cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr);
|
||||
elemObjPtr = Tcl_NewObj();
|
||||
TclNewObj(elemObjPtr);
|
||||
Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
|
||||
} else {
|
||||
cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
|
||||
@@ -763,7 +763,7 @@ InfoCommandsCmd(
|
||||
|| Tcl_StringMatch(cmdName, simplePattern)) {
|
||||
if (specificNsInPattern) {
|
||||
cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr);
|
||||
elemObjPtr = Tcl_NewObj();
|
||||
TclNewObj(elemObjPtr);
|
||||
Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
|
||||
} else {
|
||||
elemObjPtr = Tcl_NewStringObj(cmdName, -1);
|
||||
@@ -990,7 +990,8 @@ InfoDefaultCmd(
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
|
||||
} else {
|
||||
Tcl_Obj *nullObjPtr = Tcl_NewObj();
|
||||
Tcl_Obj *nullObjPtr;
|
||||
TclNewObj(nullObjPtr);
|
||||
|
||||
valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
|
||||
nullObjPtr, TCL_LEAVE_ERR_MSG);
|
||||
@@ -1906,7 +1907,7 @@ InfoProcsCmd(
|
||||
} else {
|
||||
simpleProcOK:
|
||||
if (specificNsInPattern) {
|
||||
elemObjPtr = Tcl_NewObj();
|
||||
TclNewObj(elemObjPtr);
|
||||
Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
|
||||
elemObjPtr);
|
||||
} else {
|
||||
@@ -1934,7 +1935,7 @@ InfoProcsCmd(
|
||||
} else {
|
||||
procOK:
|
||||
if (specificNsInPattern) {
|
||||
elemObjPtr = Tcl_NewObj();
|
||||
TclNewObj(elemObjPtr);
|
||||
Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
|
||||
elemObjPtr);
|
||||
} else {
|
||||
@@ -2202,8 +2203,8 @@ Tcl_JoinObjCmd(
|
||||
Tcl_Obj *const objv[]) /* The argument objects. */
|
||||
{
|
||||
Tcl_Size length, listLen;
|
||||
int isArithSeries = 0;
|
||||
Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;
|
||||
int status;
|
||||
Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs = NULL;
|
||||
|
||||
if ((objc < 2) || (objc > 3)) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
|
||||
@@ -2215,9 +2216,12 @@ Tcl_JoinObjCmd(
|
||||
* pointer to its array of element pointers.
|
||||
*/
|
||||
|
||||
if (TclHasInternalRep(objv[1],&tclArithSeriesType.objType)) {
|
||||
isArithSeries = 1;
|
||||
listLen = ABSTRACTLIST_PROC(objv[1], lengthProc)(objv[1]);
|
||||
if (TclObjectHasInterface(objv[1], list, length)) {
|
||||
status = TclObjectDispatchNoDefault(interp, status, objv[1], list,
|
||||
length, interp, objv[1], &listLen);
|
||||
if (status != TCL_OK ) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
} else {
|
||||
if (TclListObjGetElementsM(interp, objv[1], &listLen,
|
||||
&elemPtrs) != TCL_OK) {
|
||||
@@ -2230,14 +2234,22 @@ Tcl_JoinObjCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
if (listLen == 1) {
|
||||
Tcl_Obj *valueObj;
|
||||
/* One element; return it */
|
||||
if (isArithSeries) {
|
||||
Tcl_Obj *valueObj = TclArithSeriesObjIndex(interp, objv[1], 0);
|
||||
if (valueObj == NULL) {
|
||||
if (TclObjectHasInterface(objv[1], list, index)) {
|
||||
TclObjectDispatchNoDefault(interp, status, objv[1], list,
|
||||
index, interp, objv[1], 0, &valueObj);
|
||||
if (status != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_SetObjResult(interp, valueObj);
|
||||
} else {
|
||||
if (elemPtrs == NULL) {
|
||||
if (TclListObjGetElementsM(interp, objv[1], &listLen,
|
||||
&elemPtrs) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
}
|
||||
Tcl_SetObjResult(interp, elemPtrs[0]);
|
||||
}
|
||||
return TCL_OK;
|
||||
@@ -2248,12 +2260,16 @@ Tcl_JoinObjCmd(
|
||||
|
||||
(void) Tcl_GetStringFromObj(joinObjPtr, &length);
|
||||
if (length == 0) {
|
||||
if (TclListObjGetElementsM(interp, objv[1], &listLen,
|
||||
&elemPtrs) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
|
||||
} else {
|
||||
Tcl_Size i;
|
||||
|
||||
resObjPtr = Tcl_NewObj();
|
||||
if (isArithSeries) {
|
||||
TclNewObj(resObjPtr);
|
||||
if (TclObjectHasInterface(objv[1], list, index)) {
|
||||
Tcl_Obj *valueObj;
|
||||
for (i = 0; i < listLen; i++) {
|
||||
if (i > 0) {
|
||||
@@ -2267,14 +2283,21 @@ Tcl_JoinObjCmd(
|
||||
|
||||
Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
|
||||
}
|
||||
valueObj = TclArithSeriesObjIndex(interp, objv[1], i);
|
||||
if (valueObj == NULL) {
|
||||
TclObjectDispatchNoDefault(interp, status, objv[1], list,
|
||||
index, interp, objv[1], i, &valueObj);
|
||||
if (status != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_AppendObjToObj(resObjPtr, valueObj);
|
||||
Tcl_DecrRefCount(valueObj);
|
||||
TclBounceRefCount(valueObj);
|
||||
}
|
||||
} else {
|
||||
if (elemPtrs == NULL) {
|
||||
if (TclListObjGetElementsM(interp, objv[1], &listLen,
|
||||
&elemPtrs) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
}
|
||||
for (i = 0; i < listLen; i++) {
|
||||
if (i > 0) {
|
||||
|
||||
@@ -2326,19 +2349,27 @@ Tcl_LassignObjCmd(
|
||||
Tcl_Obj *listCopyPtr;
|
||||
Tcl_Obj **listObjv; /* The contents of the list. */
|
||||
Tcl_Size listObjc; /* The length of the list. */
|
||||
int code = TCL_OK;
|
||||
Tcl_Size origListObjc; /* Original length */
|
||||
int code;
|
||||
|
||||
if (objc < 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "list ?varName ...?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
listCopyPtr = TclListObjCopy(interp, objv[1]);
|
||||
if (listCopyPtr == NULL) {
|
||||
listCopyPtr = TclDuplicatePureObj(interp, objv[1], tclListType);
|
||||
if (!listCopyPtr) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_IncrRefCount(listCopyPtr); /* Important! fs */
|
||||
|
||||
TclListObjGetElementsM(NULL, listCopyPtr, &listObjc, &listObjv);
|
||||
code = TclListObjGetElementsM(
|
||||
interp, listCopyPtr, &listObjc, &listObjv);
|
||||
if (code != TCL_OK) {
|
||||
Tcl_DecrRefCount(listCopyPtr);
|
||||
return code;
|
||||
}
|
||||
origListObjc = listObjc;
|
||||
|
||||
objc -= 2;
|
||||
objv += 2;
|
||||
@@ -2366,7 +2397,13 @@ Tcl_LassignObjCmd(
|
||||
}
|
||||
|
||||
if (code == TCL_OK && listObjc > 0) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewListObj(listObjc, listObjv));
|
||||
Tcl_Obj *resultObjPtr = TclListObjRange(
|
||||
interp, listCopyPtr, origListObjc - listObjc, origListObjc - 1);
|
||||
if (resultObjPtr == NULL) {
|
||||
code = TCL_ERROR;
|
||||
} else {
|
||||
Tcl_SetObjResult(interp, resultObjPtr);
|
||||
}
|
||||
}
|
||||
|
||||
Tcl_DecrRefCount(listCopyPtr);
|
||||
@@ -2457,7 +2494,7 @@ Tcl_LinsertObjCmd(
|
||||
{
|
||||
Tcl_Obj *listPtr;
|
||||
Tcl_Size len, index;
|
||||
int result;
|
||||
int copied = 0, result;
|
||||
|
||||
if (objc < 3) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?");
|
||||
@@ -2490,7 +2527,11 @@ Tcl_LinsertObjCmd(
|
||||
|
||||
listPtr = objv[1];
|
||||
if (Tcl_IsShared(listPtr)) {
|
||||
listPtr = TclListObjCopy(NULL, listPtr);
|
||||
listPtr = TclDuplicatePureObj(interp, listPtr, tclListType);
|
||||
if (!listPtr) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
copied = 1;
|
||||
}
|
||||
|
||||
if ((objc == 4) && (index == len)) {
|
||||
@@ -2498,10 +2539,19 @@ Tcl_LinsertObjCmd(
|
||||
* Special case: insert one element at the end of the list.
|
||||
*/
|
||||
|
||||
Tcl_ListObjAppendElement(NULL, listPtr, objv[3]);
|
||||
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;
|
||||
}
|
||||
}
|
||||
@@ -2625,7 +2675,7 @@ Tcl_LpopObjCmd(
|
||||
/* Argument objects. */
|
||||
{
|
||||
Tcl_Size listLen;
|
||||
int result;
|
||||
int copied = 0, result;
|
||||
Tcl_Obj *elemPtr, *stored;
|
||||
Tcl_Obj *listPtr, **elemPtrs;
|
||||
|
||||
@@ -2677,23 +2727,33 @@ Tcl_LpopObjCmd(
|
||||
|
||||
if (objc == 2) {
|
||||
if (Tcl_IsShared(listPtr)) {
|
||||
listPtr = TclListObjCopy(NULL, 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;
|
||||
}
|
||||
Tcl_IncrRefCount(listPtr);
|
||||
} else {
|
||||
listPtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL);
|
||||
|
||||
if (listPtr == NULL) {
|
||||
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);
|
||||
Tcl_DecrRefCount(listPtr);
|
||||
if (stored == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -2726,8 +2786,8 @@ Tcl_LrangeObjCmd(
|
||||
Tcl_Obj *const objv[])
|
||||
/* Argument objects. */
|
||||
{
|
||||
int result;
|
||||
Tcl_Size listLen, first, last;
|
||||
int result, status;
|
||||
Tcl_Size fromAnchor, first, fromIdx, last, listLen, toAnchor, toIdx;
|
||||
if (objc != 4) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "list first last");
|
||||
return TCL_ERROR;
|
||||
@@ -2738,28 +2798,53 @@ Tcl_LrangeObjCmd(
|
||||
return result;
|
||||
}
|
||||
|
||||
result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1,
|
||||
&first);
|
||||
result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ TCL_SIZE_MAX - 1,
|
||||
&toIdx);
|
||||
if (result != TCL_OK) {
|
||||
return result;
|
||||
}
|
||||
|
||||
result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
|
||||
&last);
|
||||
result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ TCL_SIZE_MAX - 1,
|
||||
&fromIdx);
|
||||
if (result != TCL_OK) {
|
||||
return result;
|
||||
}
|
||||
|
||||
if (TclHasInternalRep(objv[1],&tclArithSeriesType.objType)) {
|
||||
Tcl_Obj *rangeObj;
|
||||
rangeObj = TclArithSeriesObjRange(interp, objv[1], first, last);
|
||||
if (rangeObj) {
|
||||
Tcl_SetObjResult(interp, rangeObj);
|
||||
} else {
|
||||
toAnchor = TclIndexIsFromEnd(toIdx);
|
||||
fromAnchor = TclIndexIsFromEnd(fromIdx);
|
||||
|
||||
if (!Tcl_LengthIsFinite(listLen)
|
||||
&& (toAnchor == 1 || fromAnchor == 1)
|
||||
&& TclObjectHasInterface(objv[1], list, rangeEnd)
|
||||
) {
|
||||
Tcl_Obj *objResultPtr;
|
||||
|
||||
status = TclObjectDispatchNoDefault(interp, objResultPtr,
|
||||
objv[1], list, rangeEnd, interp, objv[1], toAnchor,
|
||||
toIdx, fromAnchor, fromIdx);
|
||||
if (status != TCL_OK || objResultPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
} else {
|
||||
Tcl_SetObjResult(interp, objResultPtr);
|
||||
}
|
||||
} else {
|
||||
Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
|
||||
result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1,
|
||||
&first);
|
||||
if (result != TCL_OK) {
|
||||
return result;
|
||||
}
|
||||
|
||||
result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
|
||||
&last);
|
||||
if (result != TCL_OK) {
|
||||
return result;
|
||||
}
|
||||
|
||||
Tcl_Obj *resultObj = TclListObjRange(interp, objv[1], first, last);
|
||||
if (resultObj == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_SetObjResult(interp, resultObj);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -2806,6 +2891,7 @@ Tcl_LremoveObjCmd(
|
||||
Tcl_Size i, idxc, prevIdx, first, num;
|
||||
Tcl_Size *idxv, listLen;
|
||||
Tcl_Obj *listObj;
|
||||
int copied = 0, status = TCL_OK;
|
||||
|
||||
/*
|
||||
* Parse the arguments.
|
||||
@@ -2828,10 +2914,10 @@ Tcl_LremoveObjCmd(
|
||||
}
|
||||
idxv = (Tcl_Size *)Tcl_Alloc((objc - 2) * sizeof(*idxv));
|
||||
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;
|
||||
status = (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1,
|
||||
&idxv[i - 2]) != TCL_OK);
|
||||
if (status != TCL_OK) {
|
||||
goto done;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2849,7 +2935,12 @@ Tcl_LremoveObjCmd(
|
||||
*/
|
||||
|
||||
if (Tcl_IsShared(listObj)) {
|
||||
listObj = TclListObjCopy(NULL, listObj);
|
||||
listObj = TclDuplicatePureObj(interp, listObj, tclListType);
|
||||
if (!listObj) {
|
||||
status = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
copied = 1;
|
||||
}
|
||||
num = 0;
|
||||
first = listLen;
|
||||
@@ -2884,18 +2975,28 @@ Tcl_LremoveObjCmd(
|
||||
* and we're only ever contracting that list.
|
||||
*/
|
||||
|
||||
(void) Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);
|
||||
status = Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);
|
||||
if (status != TCL_OK) {
|
||||
goto done;
|
||||
}
|
||||
listLen -= num;
|
||||
num = 1;
|
||||
first = idx;
|
||||
}
|
||||
}
|
||||
if (num != 0) {
|
||||
(void) Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);
|
||||
status = Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);
|
||||
if (status != TCL_OK) {
|
||||
if (copied) {
|
||||
Tcl_DecrRefCount(listObj);
|
||||
}
|
||||
goto done;
|
||||
}
|
||||
}
|
||||
Tcl_Free(idxv);
|
||||
Tcl_SetObjResult(interp, listObj);
|
||||
return TCL_OK;
|
||||
done:
|
||||
Tcl_Free(idxv);
|
||||
return status;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -2923,7 +3024,7 @@ Tcl_LrepeatObjCmd(
|
||||
Tcl_Obj *const objv[])
|
||||
/* The argument objects. */
|
||||
{
|
||||
int elementCount, i, totalElems;
|
||||
Tcl_Size elementCount, i, totalElems;
|
||||
Tcl_Obj *listPtr, **dataArray = NULL;
|
||||
|
||||
/*
|
||||
@@ -2935,12 +3036,12 @@ Tcl_LrepeatObjCmd(
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "count ?value ...?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (TCL_OK != TclGetIntFromObj(interp, objv[1], &elementCount)) {
|
||||
if (TCL_OK != TclGetSizeIntFromObj(interp, objv[1], &elementCount)) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (elementCount < 0) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"bad count \"%d\": must be integer >= 0", elementCount));
|
||||
"bad count \"%" TCL_SIZE_MODIFIER "d\": must be integer >= 0", elementCount));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG",
|
||||
NULL);
|
||||
return TCL_ERROR;
|
||||
@@ -2997,7 +3098,7 @@ Tcl_LrepeatObjCmd(
|
||||
dataArray[i] = tmpPtr;
|
||||
}
|
||||
} else {
|
||||
int j, k = 0;
|
||||
Tcl_Size j, k = 0;
|
||||
|
||||
for (i=0 ; i<elementCount ; i++) {
|
||||
for (j=0 ; j<objc ; j++) {
|
||||
@@ -3089,7 +3190,10 @@ Tcl_LreplaceObjCmd(
|
||||
|
||||
listPtr = objv[1];
|
||||
if (Tcl_IsShared(listPtr)) {
|
||||
listPtr = TclListObjCopy(NULL, listPtr);
|
||||
listPtr = TclDuplicatePureObj(interp, listPtr, tclListType);
|
||||
if (!listPtr) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -3102,6 +3206,7 @@ Tcl_LreplaceObjCmd(
|
||||
|
||||
if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
|
||||
objc-4, objv+4)) {
|
||||
Tcl_DecrRefCount(listPtr);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
@@ -3145,19 +3250,18 @@ Tcl_LreverseObjCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Handle ArithSeries special case - don't shimmer a series into a list
|
||||
* just to reverse it.
|
||||
*/
|
||||
if (TclHasInternalRep(objv[1],&tclArithSeriesType.objType)) {
|
||||
Tcl_Obj *resObj = TclArithSeriesObjReverse(interp, objv[1]);
|
||||
if (TclObjectHasInterface(objv[1], list, reverse)) {
|
||||
TCL_UNUSEDVAR(int status);
|
||||
Tcl_Obj *resObj;
|
||||
TclObjectDispatchNoDefault(interp, resObj, objv[1], list,
|
||||
reverse, interp, objv[1]);
|
||||
if (resObj) {
|
||||
Tcl_SetObjResult(interp, resObj);
|
||||
return TCL_OK;
|
||||
} else {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
} /* end ArithSeries */
|
||||
}
|
||||
|
||||
/* True List */
|
||||
if (TclListObjLengthM(interp, objv[1], &elemc) != TCL_OK) {
|
||||
@@ -3243,15 +3347,16 @@ Tcl_LsearchObjCmd(
|
||||
Tcl_Obj *const objv[]) /* Argument values. */
|
||||
{
|
||||
const char *bytes, *patternBytes;
|
||||
int match, index, result=TCL_OK, bisect;
|
||||
Tcl_Size i, length = 0, listc, elemLen, start, groupSize, groupOffset, lower, upper;
|
||||
int match, result=TCL_OK, bisect;
|
||||
Tcl_Size i, length = 0, listc, elemLen, start, index;
|
||||
Tcl_Size 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;
|
||||
Tcl_Obj *patObj, *itemPtr, *item2Ptr, *listPtr, *subjectPtr, *startPtr;
|
||||
SortStrCmpFn_t strCmpFn = TclUtfCmp;
|
||||
Tcl_RegExp regexp = NULL;
|
||||
static const char *const options[] = {
|
||||
@@ -3281,6 +3386,7 @@ Tcl_LsearchObjCmd(
|
||||
isIncreasing = 1;
|
||||
allMatches = 0;
|
||||
inlineReturn = 0;
|
||||
itemPtr = NULL;
|
||||
returnSubindices = 0;
|
||||
negatedMatch = 0;
|
||||
bisect = 0;
|
||||
@@ -3549,7 +3655,8 @@ Tcl_LsearchObjCmd(
|
||||
* pointer to its array of element pointers.
|
||||
*/
|
||||
|
||||
result = TclListObjGetElementsM(interp, objv[objc - 2], &listc, &listv);
|
||||
subjectPtr = objv[objc-2];
|
||||
result = Tcl_ListObjLength(interp, subjectPtr, &listc);
|
||||
if (result != TCL_OK) {
|
||||
goto done;
|
||||
}
|
||||
@@ -3603,7 +3710,8 @@ Tcl_LsearchObjCmd(
|
||||
*/
|
||||
|
||||
if (startPtr) {
|
||||
result = TclGetIntForIndexM(interp, startPtr, listc-1, &start);
|
||||
result = TclGetIntForIndexM(interp, startPtr,
|
||||
(Tcl_LengthIsFinite(listc) ? listc - 1 : TCL_SIZE_MAX), &start);
|
||||
if (result != TCL_OK) {
|
||||
goto done;
|
||||
}
|
||||
@@ -3612,16 +3720,17 @@ Tcl_LsearchObjCmd(
|
||||
}
|
||||
|
||||
/*
|
||||
* If the search started past the end of the list, we just return a
|
||||
* If the search started past the end of the list, just return a
|
||||
* "did not match anything at all" result straight away. [Bug 1374778]
|
||||
*/
|
||||
|
||||
if (start >= listc) {
|
||||
if (Tcl_LengthIsFinite(listc) && start >= listc) {
|
||||
if (allMatches || inlineReturn) {
|
||||
Tcl_ResetResult(interp);
|
||||
} else {
|
||||
TclNewIntObj(itemPtr, -1);
|
||||
Tcl_SetObjResult(interp, itemPtr);
|
||||
itemPtr = NULL;
|
||||
}
|
||||
goto done;
|
||||
}
|
||||
@@ -3650,11 +3759,9 @@ Tcl_LsearchObjCmd(
|
||||
}
|
||||
|
||||
/*
|
||||
* List representation might have been shimmered; restore it. [Bug
|
||||
* 1844789]
|
||||
* [Bug 1844789], "lsearch -exact -integer ..." crashes, was
|
||||
* previously fixed at this point.
|
||||
*/
|
||||
|
||||
TclListObjGetElementsM(NULL, objv[objc - 2], &listc, &listv);
|
||||
break;
|
||||
case REAL:
|
||||
result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble);
|
||||
@@ -3663,11 +3770,9 @@ Tcl_LsearchObjCmd(
|
||||
}
|
||||
|
||||
/*
|
||||
* List representation might have been shimmered; restore it. [Bug
|
||||
* 1844789]
|
||||
* [Bug 1844789], "lsearch -exact -integer ..." crashes, was
|
||||
* previously fixed at this point.
|
||||
*/
|
||||
|
||||
TclListObjGetElementsM(NULL, objv[objc - 2], &listc, &listv);
|
||||
break;
|
||||
}
|
||||
} else {
|
||||
@@ -3683,6 +3788,7 @@ Tcl_LsearchObjCmd(
|
||||
match = 0;
|
||||
|
||||
if (mode == SORTED && !allMatches && !negatedMatch) {
|
||||
int isfinite;
|
||||
/*
|
||||
* If the data is sorted, we can do a more intelligent search. Note
|
||||
* that there is no point in being smart when -all was specified; in
|
||||
@@ -3695,18 +3801,57 @@ Tcl_LsearchObjCmd(
|
||||
*/
|
||||
|
||||
lower = start - groupSize;
|
||||
upper = listc;
|
||||
while (lower + groupSize != upper && sortInfo.resultCode == TCL_OK) {
|
||||
i = (lower + upper)/2;
|
||||
isfinite = Tcl_LengthIsFinite(listc);
|
||||
if (isfinite) {
|
||||
upper = listc;
|
||||
} else {
|
||||
upper = 1;
|
||||
}
|
||||
while (
|
||||
(lower + groupSize < upper && sortInfo.resultCode == TCL_OK)
|
||||
|| !isfinite
|
||||
) {
|
||||
i = (lower + upper) / 2;
|
||||
if (i < 0) {
|
||||
result = TCL_ERROR;
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj("sorted list is incoherent", -1));
|
||||
goto done;
|
||||
}
|
||||
i -= i % groupSize;
|
||||
result = Tcl_ListObjIndex(interp, subjectPtr, i+groupOffset, &itemPtr);
|
||||
if (result != TCL_OK) {
|
||||
if (isfinite) {
|
||||
goto done;
|
||||
} else {
|
||||
if (Tcl_ListObjLength(interp, subjectPtr, &listc) == TCL_OK) {
|
||||
isfinite = Tcl_LengthIsFinite(listc);
|
||||
if (isfinite) {
|
||||
if (listc - 1 > i) {
|
||||
upper = listc = 1;
|
||||
break;
|
||||
} else {
|
||||
goto done;
|
||||
}
|
||||
} else {
|
||||
goto done;
|
||||
}
|
||||
} else {
|
||||
goto done;
|
||||
}
|
||||
}
|
||||
}
|
||||
Tcl_IncrRefCount(itemPtr);
|
||||
if (sortInfo.indexc != 0) {
|
||||
itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
|
||||
item2Ptr = SelectObjFromSublist(itemPtr, &sortInfo);
|
||||
if (sortInfo.resultCode != TCL_OK) {
|
||||
result = sortInfo.resultCode;
|
||||
goto done;
|
||||
}
|
||||
} else {
|
||||
itemPtr = listv[i+groupOffset];
|
||||
/* Increment item2Ptr refcount first in case it's the same
|
||||
* object as itemPtr. */
|
||||
Tcl_IncrRefCount(item2Ptr);
|
||||
Tcl_DecrRefCount(itemPtr);
|
||||
itemPtr = item2Ptr;
|
||||
}
|
||||
switch (dataType) {
|
||||
case ASCII:
|
||||
@@ -3744,6 +3889,8 @@ Tcl_LsearchObjCmd(
|
||||
}
|
||||
break;
|
||||
}
|
||||
Tcl_DecrRefCount(itemPtr);
|
||||
itemPtr = NULL;
|
||||
if (match == 0) {
|
||||
/*
|
||||
* Normally, binary search is written to stop when it finds a
|
||||
@@ -3770,14 +3917,22 @@ Tcl_LsearchObjCmd(
|
||||
} else if (match > 0) {
|
||||
if (isIncreasing) {
|
||||
lower = i;
|
||||
if (!isfinite) {
|
||||
upper *= 2;
|
||||
}
|
||||
} else {
|
||||
upper = i;
|
||||
isfinite = 1;
|
||||
}
|
||||
} else {
|
||||
if (isIncreasing) {
|
||||
upper = i;
|
||||
isfinite = 1;
|
||||
} else {
|
||||
lower = i;
|
||||
if (!isfinite) {
|
||||
upper *= 2;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -3795,10 +3950,15 @@ Tcl_LsearchObjCmd(
|
||||
if (allMatches) {
|
||||
listPtr = Tcl_NewListObj(0, NULL);
|
||||
}
|
||||
for (i = start; i < listc; i += groupSize) {
|
||||
for (i = start; listc < 0 || i < listc; i += groupSize) {
|
||||
match = 0;
|
||||
result = Tcl_ListObjIndex(interp, subjectPtr, i+groupOffset, &itemPtr);
|
||||
if (result != TCL_OK) {
|
||||
goto done;
|
||||
}
|
||||
Tcl_IncrRefCount(itemPtr);
|
||||
if (sortInfo.indexc != 0) {
|
||||
itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
|
||||
item2Ptr = SelectObjFromSublist(itemPtr, &sortInfo);
|
||||
if (sortInfo.resultCode != TCL_OK) {
|
||||
if (listPtr != NULL) {
|
||||
Tcl_DecrRefCount(listPtr);
|
||||
@@ -3806,8 +3966,11 @@ Tcl_LsearchObjCmd(
|
||||
result = sortInfo.resultCode;
|
||||
goto done;
|
||||
}
|
||||
} else {
|
||||
itemPtr = listv[i+groupOffset];
|
||||
/* Increment item2Ptr refcount first in case it's the same
|
||||
* object as itemPtr. */
|
||||
Tcl_IncrRefCount(item2Ptr);
|
||||
Tcl_DecrRefCount(itemPtr);
|
||||
itemPtr = item2Ptr;
|
||||
}
|
||||
|
||||
switch (mode) {
|
||||
@@ -3885,41 +4048,66 @@ Tcl_LsearchObjCmd(
|
||||
match = !match;
|
||||
}
|
||||
if (!match) {
|
||||
Tcl_DecrRefCount(itemPtr);
|
||||
itemPtr = NULL;
|
||||
continue;
|
||||
}
|
||||
if (!allMatches) {
|
||||
index = i;
|
||||
Tcl_DecrRefCount(itemPtr);
|
||||
itemPtr = NULL;
|
||||
break;
|
||||
} else if (inlineReturn) {
|
||||
/*
|
||||
* Note that these appends are not expected to fail.
|
||||
* These append operations are expected to not fail.
|
||||
*/
|
||||
Tcl_DecrRefCount(itemPtr);
|
||||
itemPtr = NULL;
|
||||
|
||||
if (returnSubindices && (sortInfo.indexc != 0)) {
|
||||
itemPtr = SelectObjFromSublist(listv[i+groupOffset],
|
||||
&sortInfo);
|
||||
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
|
||||
result = Tcl_ListObjIndex(interp, subjectPtr, i+groupOffset, &itemPtr);
|
||||
if (result != TCL_OK) {
|
||||
goto done;
|
||||
}
|
||||
Tcl_IncrRefCount(itemPtr);
|
||||
item2Ptr = SelectObjFromSublist(itemPtr, &sortInfo);
|
||||
Tcl_ListObjAppendElement(interp, listPtr, item2Ptr);
|
||||
Tcl_DecrRefCount(itemPtr);
|
||||
} else if (groupSize > 1) {
|
||||
Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0,
|
||||
groupSize, &listv[i]);
|
||||
Tcl_Size j;
|
||||
for (j = 0; j < groupSize; j++) {
|
||||
result = Tcl_ListObjIndex(interp, subjectPtr,
|
||||
i+j, &itemPtr);
|
||||
if (result != TCL_OK) {
|
||||
goto done;
|
||||
}
|
||||
Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0,
|
||||
1, &itemPtr);
|
||||
}
|
||||
} else {
|
||||
itemPtr = listv[i];
|
||||
result = Tcl_ListObjIndex(interp, subjectPtr, i, &itemPtr);
|
||||
if (result != TCL_OK) {
|
||||
goto done;
|
||||
}
|
||||
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
|
||||
}
|
||||
} else if (returnSubindices) {
|
||||
Tcl_Size j;
|
||||
|
||||
Tcl_DecrRefCount(itemPtr);
|
||||
TclNewIndexObj(itemPtr, i+groupOffset);
|
||||
for (j=0 ; j<sortInfo.indexc ; j++) {
|
||||
Tcl_Obj *elObj;
|
||||
size_t elValue = TclIndexDecode(sortInfo.indexv[j], listc);
|
||||
Tcl_Size elValue = TclIndexDecode(sortInfo.indexv[j], listc);
|
||||
TclNewIndexObj(elObj, elValue);
|
||||
Tcl_ListObjAppendElement(interp, itemPtr, elObj);
|
||||
}
|
||||
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
|
||||
} else {
|
||||
Tcl_DecrRefCount(itemPtr);
|
||||
Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewWideIntObj(i));
|
||||
}
|
||||
itemPtr = NULL;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -3941,9 +4129,10 @@ Tcl_LsearchObjCmd(
|
||||
Tcl_ListObjAppendElement(interp, itemPtr, elObj);
|
||||
}
|
||||
Tcl_SetObjResult(interp, itemPtr);
|
||||
itemPtr = NULL;
|
||||
} else {
|
||||
Tcl_Obj *elObj;
|
||||
TclNewIndexObj(elObj, index);
|
||||
Tcl_Obj *elObj;
|
||||
TclNewIndexObj(elObj, index);
|
||||
Tcl_SetObjResult(interp, elObj);
|
||||
}
|
||||
} else if (index < 0) {
|
||||
@@ -3955,13 +4144,32 @@ Tcl_LsearchObjCmd(
|
||||
Tcl_SetObjResult(interp, Tcl_NewObj());
|
||||
} else {
|
||||
if (returnSubindices) {
|
||||
Tcl_SetObjResult(interp, SelectObjFromSublist(listv[i+groupOffset],
|
||||
&sortInfo));
|
||||
result = Tcl_ListObjIndex(interp, subjectPtr, i+groupOffset, &itemPtr);
|
||||
if (result != TCL_OK) {
|
||||
goto done;
|
||||
}
|
||||
item2Ptr = SelectObjFromSublist(itemPtr, &sortInfo);
|
||||
Tcl_SetObjResult(interp, item2Ptr);
|
||||
} else if (groupSize > 1) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewListObj(groupSize, &listv[index]));
|
||||
Tcl_Size j;
|
||||
listPtr = Tcl_NewListObj(0, NULL);
|
||||
for (j = 0; j < groupSize; j++) {
|
||||
result = Tcl_ListObjIndex(interp, subjectPtr, index + j, &itemPtr);
|
||||
if (result != TCL_OK) {
|
||||
Tcl_DecrRefCount(listPtr);
|
||||
goto done;
|
||||
}
|
||||
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
|
||||
}
|
||||
Tcl_SetObjResult(interp, listPtr);
|
||||
} else {
|
||||
Tcl_SetObjResult(interp, listv[index]);
|
||||
result = Tcl_ListObjIndex(interp, subjectPtr, index, &itemPtr);
|
||||
if (result != TCL_OK) {
|
||||
goto done;
|
||||
}
|
||||
Tcl_SetObjResult(interp, itemPtr);
|
||||
}
|
||||
itemPtr = NULL;
|
||||
}
|
||||
result = TCL_OK;
|
||||
|
||||
@@ -3970,6 +4178,9 @@ Tcl_LsearchObjCmd(
|
||||
*/
|
||||
|
||||
done:
|
||||
if (itemPtr != NULL) {
|
||||
Tcl_DecrRefCount(itemPtr);
|
||||
}
|
||||
if (startPtr != NULL) {
|
||||
Tcl_DecrRefCount(startPtr);
|
||||
}
|
||||
@@ -3978,6 +4189,7 @@ Tcl_LsearchObjCmd(
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -4708,7 +4920,7 @@ Tcl_LsortObjCmd(
|
||||
* 1675116]
|
||||
*/
|
||||
|
||||
listObj = TclListObjCopy(interp, listObj);
|
||||
listObj = TclDuplicatePureObj(interp ,listObj, tclListType);
|
||||
if (listObj == NULL) {
|
||||
sortInfo.resultCode = TCL_ERROR;
|
||||
goto done;
|
||||
@@ -4725,8 +4937,6 @@ Tcl_LsortObjCmd(
|
||||
if (Tcl_ListObjAppendElement(interp, newCommandPtr, newObjPtr)
|
||||
!= TCL_OK) {
|
||||
TclDecrRefCount(newCommandPtr);
|
||||
TclDecrRefCount(listObj);
|
||||
Tcl_IncrRefCount(newObjPtr);
|
||||
TclDecrRefCount(newObjPtr);
|
||||
sortInfo.resultCode = TCL_ERROR;
|
||||
goto done;
|
||||
@@ -4735,9 +4945,10 @@ Tcl_LsortObjCmd(
|
||||
sortInfo.compareCmdPtr = newCommandPtr;
|
||||
}
|
||||
|
||||
if (TclHasInternalRep(listObj,&tclArithSeriesType.objType)) {
|
||||
sortInfo.resultCode = TclArithSeriesGetElements(interp,
|
||||
listObj, &length, &listObjPtrs);
|
||||
if (TclObjectHasInterface(listObj, list, all)) {
|
||||
TCL_UNUSEDVAR(int status);
|
||||
sortInfo.resultCode = TclObjectDispatchNoDefault(interp, status,
|
||||
listObj, list, all, interp, listObj, &length, &listObjPtrs);
|
||||
} else {
|
||||
sortInfo.resultCode = TclListObjGetElementsM(interp, listObj,
|
||||
&length, &listObjPtrs);
|
||||
@@ -4931,7 +5142,7 @@ Tcl_LsortObjCmd(
|
||||
ListObjGetRep(resultPtr, &listRep);
|
||||
newArray = ListRepElementsBase(&listRep);
|
||||
if (group) {
|
||||
for (i=0; elementPtr!=NULL ; elementPtr=elementPtr->nextPtr) {
|
||||
for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
|
||||
idx = elementPtr->payload.index;
|
||||
for (j = 0; j < groupSize; j++) {
|
||||
if (indices) {
|
||||
@@ -5066,7 +5277,10 @@ Tcl_LeditObjCmd(
|
||||
}
|
||||
|
||||
if (Tcl_IsShared(listPtr)) {
|
||||
listPtr = TclListObjCopy(NULL, listPtr);
|
||||
listPtr = TclDuplicatePureObj(interp, listPtr, tclListType);
|
||||
if (!listPtr) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
createdNewObj = 1;
|
||||
} else {
|
||||
createdNewObj = 0;
|
||||
@@ -5083,18 +5297,10 @@ Tcl_LeditObjCmd(
|
||||
|
||||
/*
|
||||
* 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.
|
||||
* presence of traces etc.
|
||||
*/
|
||||
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;
|
||||
}
|
||||
@@ -5409,8 +5615,8 @@ DictionaryCompare(
|
||||
*/
|
||||
|
||||
if ((*left != '\0') && (*right != '\0')) {
|
||||
left += TclUtfToUCS4(left, &uniLeft);
|
||||
right += TclUtfToUCS4(right, &uniRight);
|
||||
left += Tcl_UtfToUniChar(left, &uniLeft);
|
||||
right += Tcl_UtfToUniChar(right, &uniRight);
|
||||
|
||||
/*
|
||||
* Convert both chars to lower for the comparison, because
|
||||
|
||||
+66
-56
@@ -24,6 +24,7 @@
|
||||
|
||||
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;
|
||||
@@ -357,7 +358,7 @@ Tcl_RegexpObjCmd(
|
||||
|
||||
objc = info.nsubs + 1;
|
||||
if (all <= 1) {
|
||||
resultPtr = Tcl_NewObj();
|
||||
TclNewObj(resultPtr);
|
||||
}
|
||||
}
|
||||
for (i = 0; i < objc; i++) {
|
||||
@@ -399,7 +400,7 @@ Tcl_RegexpObjCmd(
|
||||
offset + info.matches[i].start,
|
||||
offset + info.matches[i].end - 1);
|
||||
} else {
|
||||
newPtr = Tcl_NewObj();
|
||||
TclNewObj(newPtr);
|
||||
}
|
||||
}
|
||||
if (doinline) {
|
||||
@@ -1194,7 +1195,7 @@ Tcl_SplitObjCmd(
|
||||
|
||||
stringPtr = Tcl_GetStringFromObj(objv[1], &stringLen);
|
||||
end = stringPtr + stringLen;
|
||||
listPtr = Tcl_NewObj();
|
||||
TclNewObj(listPtr);
|
||||
|
||||
if (stringLen == 0) {
|
||||
/*
|
||||
@@ -1217,7 +1218,7 @@ Tcl_SplitObjCmd(
|
||||
Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS);
|
||||
|
||||
for ( ; stringPtr < end; stringPtr += len) {
|
||||
len = TclUtfToUCS4(stringPtr, &ch);
|
||||
len = Tcl_UtfToUniChar(stringPtr, &ch);
|
||||
hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR(ch), &isNew);
|
||||
if (isNew) {
|
||||
TclNewStringObj(objPtr, stringPtr, len);
|
||||
@@ -1263,9 +1264,9 @@ Tcl_SplitObjCmd(
|
||||
splitEnd = splitChars + splitCharLen;
|
||||
|
||||
for (element = stringPtr; stringPtr < end; stringPtr += len) {
|
||||
len = TclUtfToUCS4(stringPtr, &ch);
|
||||
len = Tcl_UtfToUniChar(stringPtr, &ch);
|
||||
for (p = splitChars; p < splitEnd; p += splitLen) {
|
||||
splitLen = TclUtfToUCS4(p, &splitChar);
|
||||
splitLen = Tcl_UtfToUniChar(p, &splitChar);
|
||||
if (ch == splitChar) {
|
||||
TclNewStringObj(objPtr, element, stringPtr - element);
|
||||
Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
|
||||
@@ -1311,7 +1312,7 @@ StringFirstCmd(
|
||||
|
||||
if (objc < 3 || objc > 4) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv,
|
||||
"needleString haystackString ?startIndex?");
|
||||
"needleString haystackString ?startIndex?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
@@ -1402,44 +1403,51 @@ StringIndexCmd(
|
||||
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) {
|
||||
if (TclObjectHasInterface(objv[1], string, index)) {
|
||||
int status;
|
||||
Tcl_Obj *charPtr;
|
||||
status = TclStringIndexInterface(interp, objv[1], objv[2], &charPtr) ;
|
||||
if (status != TCL_OK) {
|
||||
return status;
|
||||
} else {
|
||||
Tcl_SetObjResult(interp, charPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
} else {
|
||||
/*
|
||||
* If we have a ByteArray object, we're careful to generate a new
|
||||
* bytearray for a result.
|
||||
* Get the char length to calculate what 'end' means.
|
||||
*/
|
||||
|
||||
if (TclIsPureByteArray(objv[1])) {
|
||||
unsigned char uch = UCHAR(ch);
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
|
||||
} else {
|
||||
char buf[4] = "";
|
||||
|
||||
end = Tcl_UniCharToUtf(ch, buf);
|
||||
#if TCL_UTF_MAX < 4
|
||||
if ((ch >= 0xD800) && (end < 3)) {
|
||||
end += Tcl_UniCharToUtf(-1, buf + end);
|
||||
}
|
||||
#endif
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, end));
|
||||
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;
|
||||
}
|
||||
|
||||
/*
|
||||
* If we have a ByteArray object, we're careful to generate a new
|
||||
* bytearray for a result.
|
||||
*/
|
||||
|
||||
if (TclIsPureByteArray(objv[1])) {
|
||||
unsigned char uch = UCHAR(ch);
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
|
||||
} else {
|
||||
char buf[4] = "";
|
||||
|
||||
end = Tcl_UniCharToUtf(ch, buf);
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, end));
|
||||
}
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1612,7 +1620,7 @@ StringIsCmd(
|
||||
case STR_IS_BOOL:
|
||||
case STR_IS_TRUE:
|
||||
case STR_IS_FALSE:
|
||||
if (!TclHasInternalRep(objPtr, &tclBooleanType.objType)
|
||||
if (!TclHasInternalRep(objPtr, tclBooleanType)
|
||||
&& (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
|
||||
if (strict) {
|
||||
result = 0;
|
||||
@@ -1681,9 +1689,9 @@ StringIsCmd(
|
||||
chcomp = Tcl_UniCharIsDigit;
|
||||
break;
|
||||
case STR_IS_DOUBLE: {
|
||||
if (TclHasInternalRep(objPtr, &tclDoubleType.objType) ||
|
||||
TclHasInternalRep(objPtr, &tclIntType.objType) ||
|
||||
TclHasInternalRep(objPtr, &tclBignumType.objType)) {
|
||||
if (TclHasInternalRep(objPtr, tclDoubleType) ||
|
||||
TclHasInternalRep(objPtr, tclIntType) ||
|
||||
TclHasInternalRep(objPtr, tclBignumType)) {
|
||||
break;
|
||||
}
|
||||
string1 = Tcl_GetStringFromObj(objPtr, &length1);
|
||||
@@ -1712,8 +1720,8 @@ StringIsCmd(
|
||||
break;
|
||||
case STR_IS_INT:
|
||||
case STR_IS_ENTIER:
|
||||
if (TclHasInternalRep(objPtr, &tclIntType.objType) ||
|
||||
TclHasInternalRep(objPtr, &tclBignumType.objType)) {
|
||||
if (TclHasInternalRep(objPtr, tclIntType) ||
|
||||
TclHasInternalRep(objPtr, tclBignumType)) {
|
||||
break;
|
||||
}
|
||||
string1 = Tcl_GetStringFromObj(objPtr, &length1);
|
||||
@@ -1896,7 +1904,7 @@ StringIsCmd(
|
||||
for (; string1 < end; string1 += length2, failat++) {
|
||||
int ucs4;
|
||||
|
||||
length2 = TclUtfToUCS4(string1, &ucs4);
|
||||
length2 = Tcl_UtfToUniChar(string1, &ucs4);
|
||||
if (!chcomp(ucs4)) {
|
||||
result = 0;
|
||||
break;
|
||||
@@ -2524,7 +2532,7 @@ StringStartCmd(
|
||||
if (index > 0) {
|
||||
p = &string[index];
|
||||
|
||||
(void)TclUniCharToUCS4(p, &ch);
|
||||
ch = *p;
|
||||
for (cur = index; cur != TCL_INDEX_NONE; cur--) {
|
||||
int delta = 0;
|
||||
const Tcl_UniChar *next;
|
||||
@@ -2533,10 +2541,11 @@ StringStartCmd(
|
||||
break;
|
||||
}
|
||||
|
||||
next = TclUCS4Prev(p, string);
|
||||
next = p > string ? p - 1 : p;
|
||||
do {
|
||||
next += delta;
|
||||
delta = TclUniCharToUCS4(next, &ch);
|
||||
delta = 1;
|
||||
ch = *next;
|
||||
} while (next + delta < p);
|
||||
p = next;
|
||||
}
|
||||
@@ -2594,7 +2603,7 @@ StringEndCmd(
|
||||
p = &string[index];
|
||||
end = string+length;
|
||||
for (cur = index; p < end; cur++) {
|
||||
p += TclUniCharToUCS4(p, &ch);
|
||||
ch = *p++;
|
||||
if (!Tcl_UniCharIsWordChar(ch)) {
|
||||
break;
|
||||
}
|
||||
@@ -2642,8 +2651,8 @@ StringEqualCmd(
|
||||
*/
|
||||
|
||||
const char *string2;
|
||||
int i, match, nocase = 0, reqlength = -1;
|
||||
Tcl_Size length;
|
||||
int i, match, nocase = 0;
|
||||
Tcl_Size length, reqlength = -1;
|
||||
|
||||
if (objc < 3 || objc > 6) {
|
||||
str_cmp_args:
|
||||
@@ -2662,7 +2671,7 @@ StringEqualCmd(
|
||||
goto str_cmp_args;
|
||||
}
|
||||
i++;
|
||||
if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
|
||||
if (TclGetSizeIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
} else {
|
||||
@@ -2717,7 +2726,8 @@ StringCmpCmd(
|
||||
* the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
|
||||
*/
|
||||
|
||||
int match, nocase, reqlength, status;
|
||||
int match, nocase, status;
|
||||
Tcl_Size reqlength;
|
||||
|
||||
status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength);
|
||||
if (status != TCL_OK) {
|
||||
@@ -2736,7 +2746,7 @@ TclStringCmpOpts(
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[], /* Argument objects. */
|
||||
int *nocase,
|
||||
int *reqlength)
|
||||
Tcl_Size *reqlength)
|
||||
{
|
||||
int i;
|
||||
Tcl_Size length;
|
||||
@@ -2761,7 +2771,7 @@ TclStringCmpOpts(
|
||||
goto str_cmp_args;
|
||||
}
|
||||
i++;
|
||||
if (TclGetIntFromObj(interp, objv[i], reqlength) != TCL_OK) {
|
||||
if (TclGetSizeIntFromObj(interp, objv[i], reqlength) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
} else {
|
||||
@@ -4700,7 +4710,7 @@ TclNRTryObjCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
bodyObj = objv[1];
|
||||
handlersObj = Tcl_NewObj();
|
||||
TclNewObj(handlersObj);
|
||||
bodyShared = 0;
|
||||
haveHandlers = 0;
|
||||
for (i=2 ; i<objc ; i++) {
|
||||
|
||||
@@ -3156,7 +3156,7 @@ TclCompileFormatCmd(
|
||||
Tcl_Obj **objv, *formatObj, *tmpObj;
|
||||
const char *bytes, *start;
|
||||
int i, j;
|
||||
size_t len;
|
||||
Tcl_Size len;
|
||||
|
||||
/*
|
||||
* Don't handle any guaranteed-error cases.
|
||||
|
||||
+10
-3
@@ -41,7 +41,7 @@ static int IndexTailVarIfKnown(Tcl_Interp *interp,
|
||||
*
|
||||
* Side effects:
|
||||
* When TCL_OK is returned, the encoded index value is written
|
||||
* to *index.
|
||||
* to *indexPtr.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1411,6 +1411,13 @@ TclCompileLreplaceCmd(
|
||||
Tcl_Token *tokenPtr;
|
||||
int i;
|
||||
|
||||
/*
|
||||
* For now, disable compilation of lreplace. Figure out later if any
|
||||
* compilation can be done given that any Tcl_ObjType may implement
|
||||
* lreplace, and should return an object of the same type.
|
||||
*/
|
||||
return TCL_ERROR;
|
||||
|
||||
if (parsePtr->numWords < 4) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -2113,7 +2120,7 @@ TclCompileRegsubCmd(
|
||||
Tcl_DString pattern;
|
||||
const char *bytes;
|
||||
int exact, quantified, result = TCL_ERROR;
|
||||
size_t len;
|
||||
Tcl_Size len;
|
||||
|
||||
if ((int)parsePtr->numWords < 5 || (int)parsePtr->numWords > 6) {
|
||||
return TCL_ERROR;
|
||||
@@ -2705,7 +2712,7 @@ IndexTailVarIfKnown(
|
||||
Tcl_Obj *tailPtr;
|
||||
const char *tailName, *p;
|
||||
int n = varTokenPtr->numComponents;
|
||||
size_t len;
|
||||
Tcl_Size len;
|
||||
Tcl_Token *lastTokenPtr;
|
||||
int full, localIndex;
|
||||
|
||||
|
||||
@@ -252,7 +252,7 @@ TclCompileStringCatCmd(
|
||||
} else {
|
||||
Tcl_DecrRefCount(obj);
|
||||
if (folded) {
|
||||
size_t len;
|
||||
Tcl_Size len;
|
||||
const char *bytes = Tcl_GetStringFromObj(folded, &len);
|
||||
|
||||
PushLiteral(envPtr, bytes, len);
|
||||
@@ -270,7 +270,7 @@ TclCompileStringCatCmd(
|
||||
wordTokenPtr = TokenAfter(wordTokenPtr);
|
||||
}
|
||||
if (folded) {
|
||||
size_t len;
|
||||
Tcl_Size len;
|
||||
const char *bytes = Tcl_GetStringFromObj(folded, &len);
|
||||
|
||||
PushLiteral(envPtr, bytes, len);
|
||||
@@ -2669,7 +2669,7 @@ TclCompileTailcallCmd(
|
||||
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
|
||||
int i;
|
||||
|
||||
if (parsePtr->numWords < 2 || parsePtr->numWords > 256
|
||||
if (parsePtr->numWords < 2 || parsePtr->numWords >= 256
|
||||
|| envPtr->procPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
@@ -2093,9 +2093,9 @@ ParseLexeme(
|
||||
if (end < start + numBytes && !TclIsBareword(*end)) {
|
||||
|
||||
number:
|
||||
TclInitStringRep(literal, start, end-start);
|
||||
*lexemePtr = NUMBER;
|
||||
if (literalPtr) {
|
||||
TclInitStringRep(literal, start, end-start);
|
||||
*literalPtr = literal;
|
||||
} else {
|
||||
Tcl_DecrRefCount(literal);
|
||||
@@ -2111,7 +2111,7 @@ ParseLexeme(
|
||||
* Example: Inf + luence + () becomes a valid function call.
|
||||
* [Bug 3401704]
|
||||
*/
|
||||
if (TclHasInternalRep(literal, &tclDoubleType.objType)) {
|
||||
if (TclHasInternalRep(literal, tclDoubleType)) {
|
||||
const char *p = start;
|
||||
|
||||
while (p < end) {
|
||||
@@ -2149,13 +2149,13 @@ ParseLexeme(
|
||||
if (!TclIsBareword(*start) || *start == '_') {
|
||||
Tcl_Size scanned;
|
||||
if (Tcl_UtfCharComplete(start, numBytes)) {
|
||||
scanned = TclUtfToUCS4(start, &ch);
|
||||
scanned = Tcl_UtfToUniChar(start, &ch);
|
||||
} else {
|
||||
char utfBytes[8];
|
||||
|
||||
memcpy(utfBytes, start, numBytes);
|
||||
utfBytes[numBytes] = '\0';
|
||||
scanned = TclUtfToUCS4(utfBytes, &ch);
|
||||
scanned = Tcl_UtfToUniChar(utfBytes, &ch);
|
||||
}
|
||||
*lexemePtr = INVALID;
|
||||
Tcl_DecrRefCount(literal);
|
||||
@@ -2168,7 +2168,7 @@ ParseLexeme(
|
||||
}
|
||||
*lexemePtr = BAREWORD;
|
||||
if (literalPtr) {
|
||||
Tcl_SetStringObj(literal, start, (int) (end-start));
|
||||
Tcl_SetStringObj(literal, start, end-start);
|
||||
*literalPtr = literal;
|
||||
} else {
|
||||
Tcl_DecrRefCount(literal);
|
||||
|
||||
+36
-7
@@ -720,8 +720,8 @@ const Tcl_ObjType tclByteCodeType = {
|
||||
};
|
||||
|
||||
/*
|
||||
* subtCodeType provides the standard type managemnt procedures for the
|
||||
* substcode type, which represents substiution within a Tcl value.
|
||||
* substCodeType provides the standard type management procedures for the
|
||||
* substcode type, which represents substitution within a Tcl value.
|
||||
*/
|
||||
|
||||
static const Tcl_ObjType substCodeType = {
|
||||
@@ -776,7 +776,7 @@ TclSetByteCodeFromAny(
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
CompileEnv compEnv; /* Compilation environment structure allocated
|
||||
* in frame. */
|
||||
size_t length;
|
||||
Tcl_Size length;
|
||||
int result = TCL_OK;
|
||||
const char *stringPtr;
|
||||
Proc *procPtr = iPtr->compiledProcPtr;
|
||||
@@ -869,6 +869,18 @@ TclSetByteCodeFromAny(
|
||||
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.
|
||||
@@ -1328,7 +1340,7 @@ CompileSubstObj(
|
||||
}
|
||||
if (codePtr == NULL) {
|
||||
CompileEnv compEnv;
|
||||
size_t numBytes;
|
||||
Tcl_Size numBytes;
|
||||
const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);
|
||||
|
||||
/* TODO: Check for more TIP 280 */
|
||||
@@ -1812,7 +1824,7 @@ CompileCmdLiteral(
|
||||
const char *bytes;
|
||||
Command *cmdPtr;
|
||||
int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME;
|
||||
size_t length;
|
||||
Tcl_Size length;
|
||||
|
||||
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
|
||||
if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
|
||||
@@ -2136,7 +2148,7 @@ TclCompileScript(
|
||||
* 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
|
||||
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. */
|
||||
@@ -2167,9 +2179,26 @@ TclCompileScript(
|
||||
return;
|
||||
}
|
||||
|
||||
if (numBytes < 0) {
|
||||
numBytes = strlen(script);
|
||||
}
|
||||
|
||||
/* Each iteration compiles one command from the script. */
|
||||
|
||||
if (numBytes + 1 > 1) {
|
||||
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
|
||||
|
||||
+1
-13
@@ -316,10 +316,8 @@ typedef struct CompileEnv {
|
||||
* array byte. */
|
||||
int mallocedCodeArray; /* Set 1 if code array was expanded and
|
||||
* codeStart points into the heap.*/
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
int mallocedExceptArray; /* 1 if ExceptionRange array was expanded and
|
||||
* exceptArrayPtr points in heap, else 0. */
|
||||
#endif
|
||||
LiteralEntry *literalArrayPtr;
|
||||
/* Points to start of LiteralEntry array. */
|
||||
Tcl_Size literalArrayNext; /* Index of next free object array entry. */
|
||||
@@ -335,9 +333,6 @@ typedef struct CompileEnv {
|
||||
* current range's array entry. */
|
||||
Tcl_Size exceptArrayEnd; /* Index after the last ExceptionRange array
|
||||
* entry. */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
int mallocedExceptArray;
|
||||
#endif
|
||||
ExceptionAux *exceptAuxArrayPtr;
|
||||
/* Array of information used to restore the
|
||||
* state when processing BREAK/CONTINUE
|
||||
@@ -350,19 +345,14 @@ typedef struct CompileEnv {
|
||||
Tcl_Size cmdMapEnd; /* Index after last CmdLocation entry. */
|
||||
int mallocedCmdMap; /* 1 if command map array was expanded and
|
||||
* cmdMapPtr points in the heap, else 0. */
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
int mallocedAuxDataArray; /* 1 if aux data array was expanded and
|
||||
* auxDataArrayPtr points in heap else 0. */
|
||||
#endif
|
||||
AuxData *auxDataArrayPtr; /* Points to auxiliary data array start. */
|
||||
Tcl_Size auxDataArrayNext; /* Next free compile aux data array index.
|
||||
* auxDataArrayNext is the number of aux data
|
||||
* items and (auxDataArrayNext-1) is index of
|
||||
* current aux data array entry. */
|
||||
Tcl_Size auxDataArrayEnd; /* Index after last aux data array entry. */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
int mallocedAuxDataArray;
|
||||
#endif
|
||||
unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES];
|
||||
/* Initial storage for code. */
|
||||
LiteralEntry staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS];
|
||||
@@ -1064,7 +1054,6 @@ typedef struct {
|
||||
*----------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclNRInterpCoroutine;
|
||||
|
||||
/*
|
||||
@@ -1100,7 +1089,7 @@ 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,
|
||||
const char *script, Tcl_Size numBytes,
|
||||
CompileEnv *envPtr);
|
||||
MODULE_SCOPE void TclCompileSyntaxError(Tcl_Interp *interp,
|
||||
CompileEnv *envPtr);
|
||||
@@ -1203,7 +1192,6 @@ 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 */
|
||||
|
||||
|
||||
/*
|
||||
|
||||
+39
-212
@@ -27,10 +27,8 @@
|
||||
|
||||
#if !defined(BUILD_tcl)
|
||||
# define TCL_DEPRECATED(msg) EXTERN TCL_DEPRECATED_API(msg)
|
||||
#elif defined(TCL_NO_DEPRECATED)
|
||||
# define TCL_DEPRECATED(msg) MODULE_SCOPE
|
||||
#else
|
||||
# define TCL_DEPRECATED(msg) EXTERN
|
||||
# define TCL_DEPRECATED(msg) MODULE_SCOPE
|
||||
#endif
|
||||
|
||||
|
||||
@@ -136,7 +134,7 @@ EXTERN int Tcl_GetBooleanFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr, int *intPtr);
|
||||
/* 33 */
|
||||
EXTERN unsigned char * TclGetByteArrayFromObj(Tcl_Obj *objPtr,
|
||||
int *numBytesPtr);
|
||||
void *numBytesPtr);
|
||||
/* 34 */
|
||||
EXTERN int Tcl_GetDouble(Tcl_Interp *interp, const char *src,
|
||||
double *doublePtr);
|
||||
@@ -156,7 +154,7 @@ EXTERN int Tcl_GetLongFromObj(Tcl_Interp *interp,
|
||||
/* 40 */
|
||||
EXTERN const Tcl_ObjType * Tcl_GetObjType(const char *typeName);
|
||||
/* 41 */
|
||||
EXTERN char * TclGetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr);
|
||||
EXTERN char * TclGetStringFromObj(Tcl_Obj *objPtr, void *lengthPtr);
|
||||
/* 42 */
|
||||
EXTERN void Tcl_InvalidateStringRep(Tcl_Obj *objPtr);
|
||||
/* 43 */
|
||||
@@ -167,7 +165,7 @@ 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 *listPtr, void *objcPtr,
|
||||
Tcl_Obj ***objvPtr);
|
||||
/* 46 */
|
||||
EXTERN int Tcl_ListObjIndex(Tcl_Interp *interp,
|
||||
@@ -175,7 +173,7 @@ EXTERN int Tcl_ListObjIndex(Tcl_Interp *interp,
|
||||
Tcl_Obj **objPtrPtr);
|
||||
/* 47 */
|
||||
EXTERN int TclListObjLength(Tcl_Interp *interp,
|
||||
Tcl_Obj *listPtr, int *lengthPtr);
|
||||
Tcl_Obj *listPtr, void *lengthPtr);
|
||||
/* 48 */
|
||||
EXTERN int Tcl_ListObjReplace(Tcl_Interp *interp,
|
||||
Tcl_Obj *listPtr, Tcl_Size first,
|
||||
@@ -665,9 +663,9 @@ EXTERN const char * Tcl_SignalMsg(int sig);
|
||||
EXTERN void Tcl_SourceRCFile(Tcl_Interp *interp);
|
||||
/* 242 */
|
||||
EXTERN int TclSplitList(Tcl_Interp *interp, const char *listStr,
|
||||
int *argcPtr, const char ***argvPtr);
|
||||
void *argcPtr, const char ***argvPtr);
|
||||
/* 243 */
|
||||
EXTERN void TclSplitPath(const char *path, int *argcPtr,
|
||||
EXTERN void TclSplitPath(const char *path, void *argcPtr,
|
||||
const char ***argvPtr);
|
||||
/* Slot 244 is reserved */
|
||||
/* Slot 245 is reserved */
|
||||
@@ -1036,7 +1034,7 @@ 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);
|
||||
TCL_HASH_TYPE stackSize, int flags);
|
||||
/* 394 */
|
||||
EXTERN Tcl_Size Tcl_ReadRaw(Tcl_Channel chan, char *dst,
|
||||
Tcl_Size bytesToRead);
|
||||
@@ -1137,7 +1135,8 @@ EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr,
|
||||
/* 433 */
|
||||
EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel);
|
||||
/* 434 */
|
||||
EXTERN Tcl_UniChar * TclGetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr);
|
||||
EXTERN Tcl_UniChar * TclGetUnicodeFromObj(Tcl_Obj *objPtr,
|
||||
void *lengthPtr);
|
||||
/* Slot 435 is reserved */
|
||||
/* Slot 436 is reserved */
|
||||
/* 437 */
|
||||
@@ -1209,7 +1208,7 @@ EXTERN int Tcl_FSConvertToPathType(Tcl_Interp *interp,
|
||||
/* 460 */
|
||||
EXTERN Tcl_Obj * Tcl_FSJoinPath(Tcl_Obj *listObj, Tcl_Size elements);
|
||||
/* 461 */
|
||||
EXTERN Tcl_Obj * TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr);
|
||||
EXTERN Tcl_Obj * TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr);
|
||||
/* 462 */
|
||||
EXTERN int Tcl_FSEqualPaths(Tcl_Obj *firstPtr,
|
||||
Tcl_Obj *secondPtr);
|
||||
@@ -1306,7 +1305,7 @@ 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);
|
||||
void *sizePtr);
|
||||
/* 498 */
|
||||
EXTERN int Tcl_DictObjFirst(Tcl_Interp *interp,
|
||||
Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr,
|
||||
@@ -1612,7 +1611,7 @@ 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,
|
||||
const Tcl_ArgvInfo *argTable, void *objcPtr,
|
||||
Tcl_Obj *const *objv, Tcl_Obj ***remObjv);
|
||||
/* 605 */
|
||||
EXTERN int Tcl_GetErrorLine(Tcl_Interp *interp);
|
||||
@@ -1744,7 +1743,7 @@ 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);
|
||||
Tcl_Obj *objPtr, void *numBytesPtr);
|
||||
/* 650 */
|
||||
EXTERN unsigned char * Tcl_GetBytesFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr, Tcl_Size *numBytesPtr);
|
||||
@@ -1911,7 +1910,7 @@ typedef struct TclStubs {
|
||||
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 */
|
||||
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);
|
||||
@@ -1919,13 +1918,13 @@ typedef struct TclStubs {
|
||||
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 */
|
||||
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, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */
|
||||
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, int *lengthPtr); /* 47 */
|
||||
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 */
|
||||
@@ -2120,8 +2119,8 @@ typedef struct TclStubs {
|
||||
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 */
|
||||
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);
|
||||
@@ -2271,7 +2270,7 @@ typedef struct TclStubs {
|
||||
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 */
|
||||
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 */
|
||||
@@ -2312,7 +2311,7 @@ typedef struct TclStubs {
|
||||
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 */
|
||||
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 */
|
||||
@@ -2339,7 +2338,7 @@ typedef struct TclStubs {
|
||||
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 */
|
||||
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 */
|
||||
@@ -2375,7 +2374,7 @@ typedef struct TclStubs {
|
||||
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 (*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 */
|
||||
@@ -2482,7 +2481,7 @@ typedef struct TclStubs {
|
||||
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 (*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 */
|
||||
@@ -2527,7 +2526,7 @@ typedef struct TclStubs {
|
||||
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, int *numBytesPtr); /* 649 */
|
||||
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 */
|
||||
@@ -4026,77 +4025,29 @@ extern const TclStubs *tclStubsPtr;
|
||||
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, (int *)(void *)(sizePtr)) : \
|
||||
tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (Tcl_Size *)(void *)(sizePtr)))
|
||||
# define Tcl_GetStringFromObj(objPtr, sizePtr) \
|
||||
(sizeof(*(sizePtr)) <= sizeof(int) ? \
|
||||
tclStubsPtr->tclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \
|
||||
tclStubsPtr->tcl_GetStringFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
|
||||
# define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
|
||||
(sizeof(*(sizePtr)) <= sizeof(int) ? \
|
||||
tclStubsPtr->tclGetUnicodeFromObj(objPtr, (int *)(void *)(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), \
|
||||
#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)))
|
||||
(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
|
||||
(Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof(\
|
||||
(*(boolPtr))), (char *)(boolPtr)))
|
||||
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
|
||||
(sizeof(*(sizePtr)) <= sizeof(int) ? \
|
||||
tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (int *)(void *)(sizePtr)) : \
|
||||
tclStubsPtr->tcl_GetBytesFromObj(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
|
||||
(tclStubsPtr->tcl_GetBytesFromObj(\
|
||||
NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
|
||||
#else
|
||||
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
|
||||
(sizeof(*(sizePtr)) <= sizeof(int) ? \
|
||||
tclStubsPtr->tclGetByteArrayFromObj(objPtr, (int *)(void *)(sizePtr)) : \
|
||||
tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
|
||||
#endif
|
||||
#else
|
||||
#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
|
||||
(sizeof(*(sizePtr)) <= sizeof(int) ? \
|
||||
TclGetBytesFromObj(interp, objPtr, (int *)(void *)(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, (int *)(void *)(sizePtr)) : \
|
||||
(Tcl_GetStringFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr)))
|
||||
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
|
||||
(sizeof(*(sizePtr)) <= sizeof(int) ? \
|
||||
TclGetBytesFromObj(NULL, objPtr, (int *)(void *)(sizePtr)) : \
|
||||
(Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
|
||||
#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
|
||||
(sizeof(*(sizePtr)) <= sizeof(int) ? \
|
||||
TclGetUnicodeFromObj(objPtr, (int *)(void *)(sizePtr)) : \
|
||||
(Tcl_GetUnicodeFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr)))
|
||||
(Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr))
|
||||
#endif
|
||||
|
||||
#ifdef TCL_MEM_DEBUG
|
||||
@@ -4125,36 +4076,6 @@ extern const TclStubs *tclStubsPtr;
|
||||
#define Tcl_BackgroundError(interp) Tcl_BackgroundException((interp), TCL_ERROR)
|
||||
#define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0)
|
||||
|
||||
#if TCL_UTF_MAX < 4
|
||||
# undef Tcl_UniCharToUtfDString
|
||||
# define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString
|
||||
# undef Tcl_UtfToUniCharDString
|
||||
# define Tcl_UtfToUniCharDString Tcl_UtfToChar16DString
|
||||
# undef Tcl_UtfToUniChar
|
||||
# define Tcl_UtfToUniChar Tcl_UtfToChar16
|
||||
# undef Tcl_UniCharLen
|
||||
# define Tcl_UniCharLen Tcl_Char16Len
|
||||
# undef Tcl_UniCharToUtf
|
||||
# if defined(USE_TCL_STUBS)
|
||||
# define Tcl_UniCharToUtf(c, p) \
|
||||
(tclStubsPtr->tcl_UniCharToUtf((c)|TCL_COMBINE, (p)))
|
||||
# else
|
||||
# define Tcl_UniCharToUtf(c, p) \
|
||||
((Tcl_UniCharToUtf)((c)|TCL_COMBINE, (p)))
|
||||
# endif
|
||||
#if !defined(BUILD_tcl)
|
||||
# undef Tcl_NumUtfChars
|
||||
# define Tcl_NumUtfChars TclNumUtfChars
|
||||
# undef Tcl_GetCharLength
|
||||
# define Tcl_GetCharLength TclGetCharLength
|
||||
# undef Tcl_UtfAtIndex
|
||||
# define Tcl_UtfAtIndex TclUtfAtIndex
|
||||
# undef Tcl_GetRange
|
||||
# define Tcl_GetRange TclGetRange
|
||||
# undef Tcl_GetUniChar
|
||||
# define Tcl_GetUniChar TclGetUniChar
|
||||
#endif
|
||||
#endif
|
||||
#if defined(USE_TCL_STUBS)
|
||||
# define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
|
||||
? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))tclStubsPtr->tcl_UniCharToUtfDString \
|
||||
@@ -4168,34 +4089,6 @@ extern const TclStubs *tclStubsPtr;
|
||||
# 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), (Tcl_Size *)(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), (Tcl_Size *)(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), (Tcl_Size *)(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), (Tcl_Size *)(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), (Tcl_Size *)(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), (Tcl_Size *)(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), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv)))
|
||||
#else
|
||||
# define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
|
||||
? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_UniCharToUtfDString \
|
||||
@@ -4209,29 +4102,6 @@ extern const TclStubs *tclStubsPtr;
|
||||
# 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), (int *)(void *)(objcPtr), (objvPtr)) \
|
||||
: (Tcl_ListObjGetElements)((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr)))
|
||||
# define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \
|
||||
? TclListObjLength((interp), (listPtr), (int *)(void *)(lengthPtr)) \
|
||||
: (Tcl_ListObjLength)((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr)))
|
||||
# define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \
|
||||
? TclDictObjSize((interp), (dictPtr), (int *)(void *)(sizePtr)) \
|
||||
: (Tcl_DictObjSize)((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr)))
|
||||
# define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
|
||||
? TclSplitList((interp), (listStr), (int *)(void *)(argcPtr), (argvPtr)) \
|
||||
: (Tcl_SplitList)((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
|
||||
# define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
|
||||
? TclSplitPath((path), (int *)(void *)(argcPtr), (argvPtr)) \
|
||||
: (Tcl_SplitPath)((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
|
||||
# define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \
|
||||
? TclFSSplitPath((pathPtr), (int *)(void *)(lenPtr)) \
|
||||
: (Tcl_FSSplitPath)((pathPtr), (Tcl_Size *)(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), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv)))
|
||||
#endif /* !defined(BUILD_tcl) */
|
||||
#endif
|
||||
|
||||
/*
|
||||
@@ -4243,54 +4113,11 @@ extern const TclStubs *tclStubsPtr;
|
||||
#define Tcl_GlobalEvalObj(interp, objPtr) \
|
||||
Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
|
||||
|
||||
#if defined(TCL_8_COMPAT) && !defined(BUILD_tcl) && TCL_MAJOR_VERSION > 8
|
||||
# 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 Tcl_Close
|
||||
# define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
|
||||
|
||||
#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 */
|
||||
|
||||
+49
-29
@@ -150,7 +150,7 @@ const Tcl_ObjType tclDictType = {
|
||||
TCL_OBJTYPE_V0
|
||||
};
|
||||
|
||||
#define DictSetInternalRep(objPtr, dictRepPtr) \
|
||||
#define DictSetIntRep(objPtr, dictRepPtr) \
|
||||
do { \
|
||||
Tcl_ObjInternalRep ir; \
|
||||
ir.twoPtrValue.ptr1 = (dictRepPtr); \
|
||||
@@ -396,7 +396,7 @@ DupDictInternalRep(
|
||||
* Store in the object.
|
||||
*/
|
||||
|
||||
DictSetInternalRep(copyPtr, newDict);
|
||||
DictSetIntRep(copyPtr, newDict);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -603,7 +603,7 @@ SetDictFromAny(
|
||||
* the conversion from lists to dictionaries.
|
||||
*/
|
||||
|
||||
if (TclHasInternalRep(objPtr, &tclListType.objType)) {
|
||||
if (TclHasInternalRep(objPtr, tclListType)) {
|
||||
Tcl_Size objc, i;
|
||||
Tcl_Obj **objv;
|
||||
|
||||
@@ -711,7 +711,7 @@ SetDictFromAny(
|
||||
dict->epoch = 1;
|
||||
dict->chain = NULL;
|
||||
dict->refCount = 1;
|
||||
DictSetInternalRep(objPtr, dict);
|
||||
DictSetIntRep(objPtr, dict);
|
||||
return TCL_OK;
|
||||
|
||||
missingValue:
|
||||
@@ -890,7 +890,7 @@ InvalidateDictChain(
|
||||
dict->refCount++;
|
||||
TclInvalidateStringRep(dictObj);
|
||||
TclFreeInternalRep(dictObj);
|
||||
DictSetInternalRep(dictObj, dict);
|
||||
DictSetIntRep(dictObj, dict);
|
||||
|
||||
dict->epoch++;
|
||||
dictObj = dict->chain;
|
||||
@@ -945,7 +945,7 @@ Tcl_DictObjPut(
|
||||
hPtr = CreateChainEntry(dict, keyPtr, &isNew);
|
||||
dict->refCount++;
|
||||
TclFreeInternalRep(dictPtr)
|
||||
DictSetInternalRep(dictPtr, dict);
|
||||
DictSetIntRep(dictPtr, dict);
|
||||
Tcl_IncrRefCount(valuePtr);
|
||||
if (!isNew) {
|
||||
Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
|
||||
@@ -1045,6 +1045,26 @@ Tcl_DictObjRemove(
|
||||
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;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -1406,7 +1426,7 @@ Tcl_NewDictObj(void)
|
||||
dict->epoch = 1;
|
||||
dict->chain = NULL;
|
||||
dict->refCount = 1;
|
||||
DictSetInternalRep(dictPtr, dict);
|
||||
DictSetIntRep(dictPtr, dict);
|
||||
return dictPtr;
|
||||
#endif
|
||||
}
|
||||
@@ -1454,7 +1474,7 @@ Tcl_DbNewDictObj(
|
||||
dict->epoch = 1;
|
||||
dict->chain = NULL;
|
||||
dict->refCount = 1;
|
||||
DictSetInternalRep(dictPtr, dict);
|
||||
DictSetIntRep(dictPtr, dict);
|
||||
return dictPtr;
|
||||
}
|
||||
#else /* !TCL_MEM_DEBUG */
|
||||
@@ -1489,7 +1509,7 @@ Tcl_DbNewDictObj(
|
||||
|
||||
static int
|
||||
DictCreateCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -1539,7 +1559,7 @@ DictCreateCmd(
|
||||
|
||||
static int
|
||||
DictGetCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -1632,7 +1652,7 @@ DictGetCmd(
|
||||
|
||||
static int
|
||||
DictGetDefCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -1697,7 +1717,7 @@ DictGetDefCmd(
|
||||
|
||||
static int
|
||||
DictReplaceCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -1745,7 +1765,7 @@ DictReplaceCmd(
|
||||
|
||||
static int
|
||||
DictRemoveCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -1793,7 +1813,7 @@ DictRemoveCmd(
|
||||
|
||||
static int
|
||||
DictMergeCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -1880,7 +1900,7 @@ DictMergeCmd(
|
||||
|
||||
static int
|
||||
DictKeysCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -1959,7 +1979,7 @@ DictKeysCmd(
|
||||
|
||||
static int
|
||||
DictValuesCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2019,7 +2039,7 @@ DictValuesCmd(
|
||||
|
||||
static int
|
||||
DictSizeCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2058,7 +2078,7 @@ DictSizeCmd(
|
||||
|
||||
static int
|
||||
DictExistsCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2100,7 +2120,7 @@ DictExistsCmd(
|
||||
|
||||
static int
|
||||
DictInfoCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2144,7 +2164,7 @@ DictInfoCmd(
|
||||
|
||||
static int
|
||||
DictIncrCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2265,7 +2285,7 @@ DictIncrCmd(
|
||||
|
||||
static int
|
||||
DictLappendCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2352,7 +2372,7 @@ DictLappendCmd(
|
||||
|
||||
static int
|
||||
DictAppendCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2454,7 +2474,7 @@ DictAppendCmd(
|
||||
|
||||
static int
|
||||
DictForNRCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2650,7 +2670,7 @@ DictForLoopCallback(
|
||||
|
||||
static int
|
||||
DictMapNRCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2863,7 +2883,7 @@ DictMapLoopCallback(
|
||||
|
||||
static int
|
||||
DictSetCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2923,7 +2943,7 @@ DictSetCmd(
|
||||
|
||||
static int
|
||||
DictUnsetCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2982,7 +3002,7 @@ DictUnsetCmd(
|
||||
|
||||
static int
|
||||
DictFilterCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -3268,7 +3288,7 @@ DictFilterCmd(
|
||||
|
||||
static int
|
||||
DictUpdateCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -3427,7 +3447,7 @@ FinalizeDictUpdate(
|
||||
|
||||
static int
|
||||
DictWithCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
|
||||
@@ -875,7 +875,7 @@ PrintSourceToObj(
|
||||
for (; (*p != '\0') && (i < maxChars); p+=len) {
|
||||
int ucs4;
|
||||
|
||||
len = TclUtfToUCS4(p, &ucs4);
|
||||
len = Tcl_UtfToUniChar(p, &ucs4);
|
||||
switch (ucs4) {
|
||||
case '"':
|
||||
Tcl_AppendToObj(appendObj, "\\\"", -1);
|
||||
|
||||
+25
-131
@@ -10,7 +10,6 @@
|
||||
*/
|
||||
|
||||
#include "tclInt.h"
|
||||
#include "tclIO.h"
|
||||
|
||||
typedef size_t (LengthProc)(const char *src);
|
||||
|
||||
@@ -200,16 +199,16 @@ static struct TclEncodingProfiles {
|
||||
{"tcl8", TCL_ENCODING_PROFILE_TCL8},
|
||||
};
|
||||
#define PROFILE_TCL8(flags_) \
|
||||
((CHANNEL_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_TCL8) \
|
||||
|| (CHANNEL_PROFILE_GET(flags_) == 0 \
|
||||
((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_) \
|
||||
((CHANNEL_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_STRICT) \
|
||||
|| (CHANNEL_PROFILE_GET(flags_) == 0 \
|
||||
((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_) \
|
||||
((CHANNEL_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) \
|
||||
|| (CHANNEL_PROFILE_GET(flags_) == 0 \
|
||||
((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)
|
||||
@@ -656,11 +655,6 @@ TclInitEncodingSubsystem(void)
|
||||
type.clientData = INT2PTR(leFlags);
|
||||
Tcl_CreateEncoding(&type);
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
type.encodingName = "unicode";
|
||||
Tcl_CreateEncoding(&type);
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Need the iso8859-1 encoding in order to process binary data, so force
|
||||
* it to always be embedded. Note that this encoding *must* be a proper
|
||||
@@ -1155,7 +1149,7 @@ Tcl_ExternalToUtfDString(
|
||||
* converted string is stored. */
|
||||
{
|
||||
Tcl_ExternalToUtfDStringEx(
|
||||
NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL);
|
||||
NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_STRICT, dstPtr, NULL);
|
||||
return Tcl_DStringValue(dstPtr);
|
||||
}
|
||||
|
||||
@@ -1166,7 +1160,7 @@ Tcl_ExternalToUtfDString(
|
||||
* 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
|
||||
* "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:
|
||||
@@ -1629,7 +1623,7 @@ Tcl_UtfToExternalDStringEx(
|
||||
Tcl_Size pos = Tcl_NumUtfChars(srcStart, nBytesProcessed);
|
||||
int ucs4;
|
||||
char buf[TCL_INTEGER_SPACE];
|
||||
TclUtfToUCS4(&srcStart[nBytesProcessed], &ucs4);
|
||||
Tcl_UtfToUniChar(&srcStart[nBytesProcessed], &ucs4);
|
||||
snprintf(buf, sizeof(buf), "%" TCL_Z_MODIFIER "u", nBytesProcessed);
|
||||
Tcl_SetObjResult(
|
||||
interp,
|
||||
@@ -2532,7 +2526,7 @@ UtfToUtfProc(
|
||||
flags |= PTR2INT(clientData);
|
||||
dstEnd = dst + dstLen - ((flags & ENCODING_UTF) ? TCL_UTF_MAX : 6);
|
||||
|
||||
profile = CHANNEL_PROFILE_GET(flags);
|
||||
profile = ENCODING_PROFILE_GET(flags);
|
||||
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
|
||||
|
||||
if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
|
||||
@@ -2579,8 +2573,8 @@ UtfToUtfProc(
|
||||
} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
|
||||
/*
|
||||
* Incomplete byte sequence.
|
||||
* Always check before using TclUtfToUCS4. Not doing can so
|
||||
* cause it run beyond the end of the buffer! If we happen such an
|
||||
* Always check before using Tcl_UtfToUniChar. Not doing can so cause
|
||||
* it to 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.
|
||||
*/
|
||||
@@ -2601,12 +2595,12 @@ UtfToUtfProc(
|
||||
/* TCL_ENCODING_PROFILE_TCL8 */
|
||||
char chbuf[2];
|
||||
chbuf[0] = UCHAR(*src++); chbuf[1] = 0;
|
||||
TclUtfToUCS4(chbuf, &ch);
|
||||
Tcl_UtfToUniChar(chbuf, &ch);
|
||||
}
|
||||
dst += Tcl_UniCharToUtf(ch, dst);
|
||||
} else {
|
||||
int isInvalid = 0;
|
||||
size_t len = TclUtfToUCS4(src, &ch);
|
||||
size_t len = Tcl_UtfToUniChar(src, &ch);
|
||||
if (flags & ENCODING_INPUT) {
|
||||
if ((len < 2) && (ch != 0)) {
|
||||
isInvalid = 1;
|
||||
@@ -2634,44 +2628,10 @@ UtfToUtfProc(
|
||||
*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)) {
|
||||
@@ -2755,21 +2715,6 @@ Utf32ToUtfProc(
|
||||
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;
|
||||
|
||||
@@ -2782,20 +2727,11 @@ Utf32ToUtfProc(
|
||||
break;
|
||||
}
|
||||
|
||||
#if TCL_UTF_MAX < 4
|
||||
int prev = ch;
|
||||
#endif
|
||||
if (flags & TCL_ENCODING_LE) {
|
||||
ch = (src[3] & 0xFF) << 24 | (src[2] & 0xFF) << 16 | (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
|
||||
ch = (unsigned int)(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);
|
||||
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;
|
||||
@@ -2805,9 +2741,6 @@ Utf32ToUtfProc(
|
||||
}
|
||||
} 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;
|
||||
@@ -2821,11 +2754,6 @@ Utf32ToUtfProc(
|
||||
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;
|
||||
@@ -2835,13 +2763,6 @@ Utf32ToUtfProc(
|
||||
* 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;
|
||||
@@ -2934,7 +2855,7 @@ UtfToUtf32Proc(
|
||||
result = TCL_CONVERT_NOSPACE;
|
||||
break;
|
||||
}
|
||||
len = TclUtfToUCS4(src, &ch);
|
||||
len = Tcl_UtfToUniChar(src, &ch);
|
||||
if (SURROGATE(ch)) {
|
||||
if (PROFILE_STRICT(flags)) {
|
||||
result = TCL_CONVERT_UNKNOWN;
|
||||
@@ -3213,7 +3134,7 @@ UtfToUtf16Proc(
|
||||
result = TCL_CONVERT_NOSPACE;
|
||||
break;
|
||||
}
|
||||
len = TclUtfToUCS4(src, &ch);
|
||||
len = Tcl_UtfToUniChar(src, &ch);
|
||||
if (SURROGATE(ch)) {
|
||||
if (PROFILE_STRICT(flags)) {
|
||||
result = TCL_CONVERT_UNKNOWN;
|
||||
@@ -3322,18 +3243,7 @@ UtfToUcs2Proc(
|
||||
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)) {
|
||||
@@ -3342,7 +3252,6 @@ UtfToUcs2Proc(
|
||||
}
|
||||
ch = UNICODE_REPLACE_CHAR;
|
||||
}
|
||||
#endif
|
||||
if (PROFILE_STRICT(flags) && SURROGATE(ch)) {
|
||||
result = TCL_CONVERT_SYNTAX;
|
||||
break;
|
||||
@@ -3572,17 +3481,12 @@ TableFromUtfProc(
|
||||
}
|
||||
len = TclUtfToUniChar(src, &ch);
|
||||
|
||||
#if TCL_UTF_MAX > 3
|
||||
/* Unicode chars > +U0FFFF cannot be represented in any table encoding */
|
||||
if (ch & 0xFFFF0000) {
|
||||
word = 0;
|
||||
} else
|
||||
#else
|
||||
if (!len) {
|
||||
word = 0;
|
||||
} else
|
||||
#endif
|
||||
} else {
|
||||
word = fromUnicode[(ch >> 8)][ch & 0xFF];
|
||||
}
|
||||
|
||||
if ((word == 0) && (ch != 0)) {
|
||||
if (PROFILE_STRICT(flags)) {
|
||||
@@ -3770,24 +3674,14 @@ Iso88591FromUtfProc(
|
||||
* Check for illegal characters.
|
||||
*/
|
||||
|
||||
if (ch > 0xFF
|
||||
#if TCL_UTF_MAX < 4
|
||||
|| ((ch >= 0xD800) && (len < 3))
|
||||
#endif
|
||||
) {
|
||||
if (ch > 0xFF) {
|
||||
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 */
|
||||
}
|
||||
|
||||
@@ -4587,9 +4481,9 @@ TclEncodingProfileIdToName(
|
||||
int TclEncodingSetProfileFlags(int flags)
|
||||
{
|
||||
if (flags & TCL_ENCODING_STOPONERROR) {
|
||||
CHANNEL_PROFILE_SET(flags, TCL_ENCODING_PROFILE_STRICT);
|
||||
ENCODING_PROFILE_SET(flags, TCL_ENCODING_PROFILE_STRICT);
|
||||
} else {
|
||||
int profile = CHANNEL_PROFILE_GET(flags);
|
||||
int profile = ENCODING_PROFILE_GET(flags);
|
||||
switch (profile) {
|
||||
case TCL_ENCODING_PROFILE_TCL8:
|
||||
case TCL_ENCODING_PROFILE_STRICT:
|
||||
@@ -4597,7 +4491,7 @@ int TclEncodingSetProfileFlags(int flags)
|
||||
break;
|
||||
case 0: /* Unspecified by caller */
|
||||
default:
|
||||
CHANNEL_PROFILE_SET(flags, TCL_ENCODING_PROFILE_DEFAULT);
|
||||
ENCODING_PROFILE_SET(flags, TCL_ENCODING_PROFILE_DEFAULT);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
+34
-5
@@ -312,7 +312,17 @@ TclNamespaceEnsembleCmd(
|
||||
Tcl_AppendObjToObj(newCmd, listv[0]);
|
||||
Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
|
||||
if (patchedDict == NULL) {
|
||||
patchedDict = Tcl_DuplicateObj(objv[1]);
|
||||
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);
|
||||
@@ -596,7 +606,14 @@ TclNamespaceEnsembleCmd(
|
||||
}
|
||||
cmd = TclGetString(listv[0]);
|
||||
if (!(cmd[0] == ':' && cmd[1] == ':')) {
|
||||
Tcl_Obj *newList = Tcl_DuplicateObj(listObj);
|
||||
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) {
|
||||
@@ -606,7 +623,11 @@ TclNamespaceEnsembleCmd(
|
||||
Tcl_ListObjReplace(NULL, newList, 0, 1, 1,
|
||||
&newCmd);
|
||||
if (patchedDict == NULL) {
|
||||
patchedDict = Tcl_DuplicateObj(objv[1]);
|
||||
patchedDict = TclDuplicatePureObj(
|
||||
interp, objv[1], tclListType);
|
||||
if (!patchedDict) {
|
||||
goto freeMapAndError;
|
||||
}
|
||||
}
|
||||
Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
|
||||
newList);
|
||||
@@ -1904,7 +1925,11 @@ NsEnsembleImplementationCmdNR(
|
||||
TclListObjLengthM(NULL, prefixObj, &prefixObjc);
|
||||
|
||||
if (objc == 2) {
|
||||
copyPtr = TclListObjCopy(NULL, prefixObj);
|
||||
copyPtr = TclDuplicatePureObj(
|
||||
interp, prefixObj, tclListType);
|
||||
if (!copyPtr) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
} else {
|
||||
copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
|
||||
Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
|
||||
@@ -2304,7 +2329,11 @@ EnsembleUnknownCallback(
|
||||
* Create the "unknown" command callback to determine what to do.
|
||||
*/
|
||||
|
||||
unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
|
||||
unknownCmd = TclDuplicatePureObj(
|
||||
interp, ensemblePtr->unknownHandler, tclListType);
|
||||
if (!unknownCmd) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
TclNewObj(ensObj);
|
||||
Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
|
||||
Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
|
||||
|
||||
+6
-8
@@ -232,7 +232,11 @@ HandleBgErrors(
|
||||
* support one handler setting another handler.
|
||||
*/
|
||||
|
||||
Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix);
|
||||
Tcl_Obj *copyObj = TclDuplicatePureObj(
|
||||
interp, assocPtr->cmdPrefix, tclListType);
|
||||
if (!copyObj) {
|
||||
return;
|
||||
}
|
||||
|
||||
errPtr = assocPtr->firstBgPtr;
|
||||
|
||||
@@ -1084,9 +1088,6 @@ static const struct {
|
||||
#ifdef USE_NMAKE
|
||||
".nmake"
|
||||
#endif
|
||||
#ifdef TCL_NO_DEPRECATED
|
||||
".no-deprecate"
|
||||
#endif
|
||||
#if !TCL_THREADS
|
||||
".no-thread"
|
||||
#endif
|
||||
@@ -1108,9 +1109,6 @@ static const struct {
|
||||
#ifdef STATIC_BUILD
|
||||
".static"
|
||||
#endif
|
||||
#if TCL_UTF_MAX < 4
|
||||
".utf-16"
|
||||
#endif
|
||||
}};
|
||||
|
||||
const char *
|
||||
@@ -2048,7 +2046,7 @@ 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_Size stackSize, /* Size of stack for the new thread */
|
||||
TCL_HASH_TYPE stackSize, /* Size of stack for the new thread */
|
||||
int flags) /* Flags controlling behaviour of the new
|
||||
* thread. */
|
||||
{
|
||||
|
||||
+355
-187
File diff suppressed because it is too large
Load Diff
+1
-1
@@ -1381,7 +1381,7 @@ TclFileTemporaryCmd(
|
||||
TclNewObj(nameObj);
|
||||
}
|
||||
if (objc > 2) {
|
||||
size_t length;
|
||||
Tcl_Size length;
|
||||
Tcl_Obj *templateObj = objv[2];
|
||||
const char *string = Tcl_GetStringFromObj(templateObj, &length);
|
||||
|
||||
|
||||
@@ -807,7 +807,7 @@ TclpNativeJoinPath(
|
||||
const char *joining)
|
||||
{
|
||||
int needsSep;
|
||||
size_t length;
|
||||
Tcl_Size length;
|
||||
char *dest;
|
||||
const char *p;
|
||||
const char *start;
|
||||
@@ -848,7 +848,7 @@ TclpNativeJoinPath(
|
||||
* Append the element, eliminating duplicate and trailing slashes.
|
||||
*/
|
||||
|
||||
Tcl_SetObjLength(prefix, length + (int) strlen(p));
|
||||
Tcl_SetObjLength(prefix, length + strlen(p));
|
||||
|
||||
dest = TclGetString(prefix) + length;
|
||||
for (; *p != '\0'; p++) {
|
||||
@@ -1358,7 +1358,7 @@ Tcl_GlobObjCmd(
|
||||
globTypes->macCreator = NULL;
|
||||
|
||||
while (length-- > 0) {
|
||||
size_t len;
|
||||
Tcl_Size len;
|
||||
const char *str;
|
||||
|
||||
Tcl_ListObjIndex(interp, typePtr, length, &look);
|
||||
@@ -2188,7 +2188,7 @@ DoGlob(
|
||||
*/
|
||||
|
||||
if (*p == '\0') {
|
||||
size_t length;
|
||||
Tcl_Size length;
|
||||
Tcl_DString append;
|
||||
|
||||
/*
|
||||
@@ -2252,7 +2252,7 @@ DoGlob(
|
||||
* The current prefix must end in a separator.
|
||||
*/
|
||||
|
||||
size_t len;
|
||||
Tcl_Size len;
|
||||
const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
|
||||
|
||||
if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
|
||||
@@ -2289,7 +2289,7 @@ DoGlob(
|
||||
* This behaviour is not currently tested for in the test suite.
|
||||
*/
|
||||
|
||||
size_t len;
|
||||
Tcl_Size len;
|
||||
const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
|
||||
|
||||
if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
|
||||
|
||||
+72
-78
@@ -205,7 +205,7 @@ 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 void FreeBinaryEncoding(void);
|
||||
static Tcl_HashTable * GetChannelTable(Tcl_Interp *interp);
|
||||
static int GetInput(Channel *chanPtr);
|
||||
static void PeekAhead(Channel *chanPtr, char **dstEndPtr,
|
||||
@@ -223,8 +223,8 @@ 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_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);
|
||||
@@ -659,7 +659,7 @@ TclFinalizeIOSubsystem(void)
|
||||
statePtr->refCount--;
|
||||
}
|
||||
|
||||
if (statePtr->refCount + 1 <= 1) {
|
||||
if (statePtr->refCount <= 0) {
|
||||
/*
|
||||
* Close it only if the refcount indicates that the channel is
|
||||
* not referenced from any interpreter. If it is, that
|
||||
@@ -695,6 +695,7 @@ TclFinalizeIOSubsystem(void)
|
||||
}
|
||||
}
|
||||
|
||||
FreeBinaryEncoding();
|
||||
TclpFinalizeSockets();
|
||||
TclpFinalizePipes();
|
||||
}
|
||||
@@ -1077,7 +1078,7 @@ CheckForStdChannelsBeingClosed(
|
||||
if (tsdPtr->stdinInitialized == 1
|
||||
&& tsdPtr->stdinChannel != NULL
|
||||
&& statePtr == ((Channel *)tsdPtr->stdinChannel)->state) {
|
||||
if (statePtr->refCount + 1 < 3) {
|
||||
if (statePtr->refCount < 2) {
|
||||
statePtr->refCount = 0;
|
||||
tsdPtr->stdinChannel = NULL;
|
||||
return;
|
||||
@@ -1085,7 +1086,7 @@ CheckForStdChannelsBeingClosed(
|
||||
} else if (tsdPtr->stdoutInitialized == 1
|
||||
&& tsdPtr->stdoutChannel != NULL
|
||||
&& statePtr == ((Channel *)tsdPtr->stdoutChannel)->state) {
|
||||
if (statePtr->refCount + 1 < 3) {
|
||||
if (statePtr->refCount < 2) {
|
||||
statePtr->refCount = 0;
|
||||
tsdPtr->stdoutChannel = NULL;
|
||||
return;
|
||||
@@ -1093,7 +1094,7 @@ CheckForStdChannelsBeingClosed(
|
||||
} else if (tsdPtr->stderrInitialized == 1
|
||||
&& tsdPtr->stderrChannel != NULL
|
||||
&& statePtr == ((Channel *)tsdPtr->stderrChannel)->state) {
|
||||
if (statePtr->refCount + 1 < 3) {
|
||||
if (statePtr->refCount < 2) {
|
||||
statePtr->refCount = 0;
|
||||
tsdPtr->stderrChannel = NULL;
|
||||
return;
|
||||
@@ -1255,7 +1256,7 @@ Tcl_UnregisterChannel(
|
||||
* If the refCount reached zero, close the actual channel.
|
||||
*/
|
||||
|
||||
if (statePtr->refCount + 1 <= 1) {
|
||||
if (statePtr->refCount <= 0) {
|
||||
Tcl_Preserve(statePtr);
|
||||
if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
|
||||
/*
|
||||
@@ -1663,6 +1664,10 @@ Tcl_CreateChannel(
|
||||
}
|
||||
statePtr->channelName = tmp;
|
||||
statePtr->flags = mask;
|
||||
/* uncomment this to make default encoding error handling strict */
|
||||
/*
|
||||
statePtr->flags |= CHANNEL_ENCODING_STRICT;
|
||||
*/
|
||||
statePtr->maxPerms = mask; /* Save max privileges for close callback */
|
||||
|
||||
/*
|
||||
@@ -1679,11 +1684,11 @@ Tcl_CreateChannel(
|
||||
statePtr->encoding = Tcl_GetEncoding(NULL, name);
|
||||
statePtr->inputEncodingState = NULL;
|
||||
statePtr->inputEncodingFlags = TCL_ENCODING_START;
|
||||
CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags,
|
||||
ENCODING_PROFILE_SET(statePtr->inputEncodingFlags,
|
||||
TCL_ENCODING_PROFILE_DEFAULT);
|
||||
statePtr->outputEncodingState = NULL;
|
||||
statePtr->outputEncodingFlags = TCL_ENCODING_START;
|
||||
CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags,
|
||||
ENCODING_PROFILE_SET(statePtr->outputEncodingFlags,
|
||||
TCL_ENCODING_PROFILE_DEFAULT);
|
||||
|
||||
/*
|
||||
@@ -2003,7 +2008,7 @@ static void
|
||||
ChannelFree(
|
||||
Channel *chanPtr)
|
||||
{
|
||||
if (!chanPtr->refCount) {
|
||||
if (chanPtr->refCount == 0) {
|
||||
Tcl_Free(chanPtr);
|
||||
return;
|
||||
}
|
||||
@@ -2178,7 +2183,7 @@ Tcl_UnstackChannel(
|
||||
* necessary.
|
||||
*/
|
||||
|
||||
if (statePtr->refCount + 1 <= 1) {
|
||||
if (statePtr->refCount <= 0) {
|
||||
if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) {
|
||||
/*
|
||||
* TIP #219, Tcl Channel Reflection API.
|
||||
@@ -2546,7 +2551,7 @@ static int
|
||||
IsShared(
|
||||
ChannelBuffer *bufPtr)
|
||||
{
|
||||
return bufPtr->refCount + 1 > 2;
|
||||
return bufPtr->refCount > 1;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -2995,7 +3000,7 @@ FlushChannel(
|
||||
* current output buffer.
|
||||
*/
|
||||
|
||||
if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount + 1 <= 1) &&
|
||||
if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
|
||||
(statePtr->outQueueHead == NULL) &&
|
||||
((statePtr->curOutPtr == NULL) ||
|
||||
IsBufferEmpty(statePtr->curOutPtr))) {
|
||||
@@ -3456,7 +3461,7 @@ TclClose(
|
||||
statePtr = chanPtr->state;
|
||||
chanPtr = statePtr->topChanPtr;
|
||||
|
||||
if (statePtr->refCount + 1 > 1) {
|
||||
if (statePtr->refCount > 0) {
|
||||
Tcl_Panic("called Tcl_Close on channel with refCount > 0");
|
||||
}
|
||||
|
||||
@@ -4191,7 +4196,6 @@ Tcl_WriteChars(
|
||||
}
|
||||
|
||||
objPtr = Tcl_NewStringObj(src, len);
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
|
||||
if (src == NULL) {
|
||||
Tcl_SetErrno(EILSEQ);
|
||||
@@ -4240,6 +4244,7 @@ Tcl_WriteObj(
|
||||
Channel *chanPtr;
|
||||
ChannelState *statePtr; /* State info for channel */
|
||||
const char *src;
|
||||
Tcl_Size srcLen = 0;
|
||||
|
||||
statePtr = ((Channel *) chan)->state;
|
||||
chanPtr = statePtr->topChanPtr;
|
||||
@@ -4247,34 +4252,21 @@ Tcl_WriteObj(
|
||||
if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
|
||||
return TCL_INDEX_NONE;
|
||||
}
|
||||
|
||||
Tcl_Size srcLen;
|
||||
if (statePtr->encoding == NULL) {
|
||||
Tcl_Size result;
|
||||
|
||||
src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
|
||||
if (src == NULL) {
|
||||
Tcl_SetErrno(EILSEQ);
|
||||
return TCL_INDEX_NONE;
|
||||
result = TCL_INDEX_NONE;
|
||||
} else {
|
||||
result = WriteBytes(chanPtr, src, srcLen);
|
||||
}
|
||||
return result;
|
||||
} else {
|
||||
src = Tcl_GetStringFromObj(objPtr, &srcLen);
|
||||
return WriteChars(chanPtr, src, srcLen);
|
||||
}
|
||||
|
||||
size_t totalWritten = 0;
|
||||
/*
|
||||
* Note original code always called WriteChars even if srcLen 0
|
||||
* so we will too.
|
||||
*/
|
||||
do {
|
||||
int chunkSize = srcLen > INT_MAX ? INT_MAX : srcLen;
|
||||
int written;
|
||||
written = WriteChars(chanPtr, src, chunkSize);
|
||||
if (written < 0) {
|
||||
return TCL_INDEX_NONE;
|
||||
}
|
||||
totalWritten += written;
|
||||
srcLen -= chunkSize;
|
||||
} while (srcLen);
|
||||
return totalWritten;
|
||||
}
|
||||
|
||||
static void
|
||||
@@ -4345,17 +4337,18 @@ WillRead(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
static Tcl_Size
|
||||
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_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, saved = 0, total = 0, flushed = 0, needNlFlush = 0;
|
||||
int endEncoding, needNlFlush = 0;
|
||||
Tcl_Size saved = 0, total = 0, flushed = 0;
|
||||
char safe[BUFFER_PADDING];
|
||||
int encodingError = 0;
|
||||
|
||||
@@ -4368,7 +4361,6 @@ Write(
|
||||
*/
|
||||
|
||||
endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);
|
||||
|
||||
if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)
|
||||
|| (statePtr->outputTranslation != TCL_TRANSLATE_LF)) {
|
||||
nextNewLine = (char *)memchr(src, '\n', srcLen);
|
||||
@@ -4377,7 +4369,8 @@ Write(
|
||||
while (srcLen + saved + endEncoding > 0 && !encodingError) {
|
||||
ChannelBuffer *bufPtr;
|
||||
char *dst;
|
||||
int result, srcRead, dstLen, dstWrote, srcLimit = srcLen;
|
||||
int result, srcRead, dstLen, dstWrote;
|
||||
Tcl_Size srcLimit = srcLen;
|
||||
|
||||
if (nextNewLine) {
|
||||
srcLimit = nextNewLine - src;
|
||||
@@ -4567,7 +4560,7 @@ Tcl_Gets(
|
||||
|
||||
TclNewObj(objPtr);
|
||||
charsStored = Tcl_GetsObj(chan, objPtr);
|
||||
if (charsStored + 1 > 1) {
|
||||
if (charsStored > 0) {
|
||||
TclDStringAppendObj(lineRead, objPtr);
|
||||
}
|
||||
TclDecrRefCount(objPtr);
|
||||
@@ -4649,7 +4642,7 @@ Tcl_GetsObj(
|
||||
if (statePtr->encoding == GetBinaryEncoding()
|
||||
&& ((statePtr->inputTranslation == TCL_TRANSLATE_LF)
|
||||
|| (statePtr->inputTranslation == TCL_TRANSLATE_CR))
|
||||
&& Tcl_GetByteArrayFromObj(objPtr, (size_t *)NULL) != NULL) {
|
||||
&& Tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)NULL) != NULL) {
|
||||
return TclGetsObjBinary(chan, objPtr);
|
||||
}
|
||||
|
||||
@@ -5301,8 +5294,7 @@ TclGetsObjBinary(
|
||||
*/
|
||||
|
||||
static void
|
||||
FreeBinaryEncoding(
|
||||
TCL_UNUSED(void *))
|
||||
FreeBinaryEncoding(void)
|
||||
{
|
||||
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
|
||||
|
||||
@@ -5319,7 +5311,6 @@ GetBinaryEncoding(void)
|
||||
|
||||
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");
|
||||
@@ -5942,8 +5933,9 @@ DoReadChars(
|
||||
|
||||
if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) {
|
||||
ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR);
|
||||
/* TODO: We don't need this call? */
|
||||
/* TODO: UpdateInterest not needed here? */
|
||||
UpdateInterest(chanPtr);
|
||||
|
||||
Tcl_SetErrno(EILSEQ);
|
||||
return -1;
|
||||
}
|
||||
@@ -5959,7 +5951,7 @@ DoReadChars(
|
||||
assert(statePtr->inputEncodingFlags & TCL_ENCODING_END);
|
||||
assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR));
|
||||
|
||||
/* TODO: We don't need this call? */
|
||||
/* TODO: UpdateInterest not needed here? */
|
||||
UpdateInterest(chanPtr);
|
||||
return 0;
|
||||
}
|
||||
@@ -5973,7 +5965,7 @@ DoReadChars(
|
||||
}
|
||||
ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
|
||||
statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
|
||||
/* TODO: We don't need this call? */
|
||||
/* TODO: UpdateInterest not needed here? */
|
||||
UpdateInterest(chanPtr);
|
||||
return 0;
|
||||
}
|
||||
@@ -5990,7 +5982,7 @@ DoReadChars(
|
||||
&& (statePtr->inEofChar == '\0');
|
||||
|
||||
if (appendFlag) {
|
||||
if (binaryMode && (NULL == Tcl_GetByteArrayFromObj(objPtr, (size_t *)NULL))) {
|
||||
if (binaryMode && (NULL == Tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)NULL))) {
|
||||
binaryMode = 0;
|
||||
}
|
||||
} else {
|
||||
@@ -6010,7 +6002,7 @@ DoReadChars(
|
||||
}
|
||||
ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
|
||||
statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
|
||||
for (copied = 0; toRead > 0 || toRead == TCL_INDEX_NONE; ) {
|
||||
for (copied = 0; toRead != 0 ; ) {
|
||||
int copiedNow = -1;
|
||||
if (statePtr->inQueueHead != NULL) {
|
||||
if (binaryMode) {
|
||||
@@ -6020,7 +6012,7 @@ DoReadChars(
|
||||
}
|
||||
|
||||
/*
|
||||
* If the current buffer is empty recycle it.
|
||||
* Recycle current buffer if empty.
|
||||
*/
|
||||
|
||||
bufPtr = statePtr->inQueueHead;
|
||||
@@ -6044,6 +6036,7 @@ DoReadChars(
|
||||
if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
|
||||
&& !GotFlag(statePtr, CHANNEL_STICKY_EOF)
|
||||
&& (!GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
|
||||
copied = -1;
|
||||
goto finish;
|
||||
}
|
||||
}
|
||||
@@ -6123,6 +6116,9 @@ finish:
|
||||
copied = -1;
|
||||
}
|
||||
TclChannelRelease((Tcl_Channel)chanPtr);
|
||||
if (copied == TCL_INDEX_NONE) {
|
||||
ResetFlag(statePtr, CHANNEL_ENCODING_ERROR|CHANNEL_EOF);
|
||||
}
|
||||
return copied;
|
||||
}
|
||||
|
||||
@@ -7066,7 +7062,7 @@ GetInput(
|
||||
bufPtr->nextPtr = NULL;
|
||||
|
||||
toRead = SpaceLeft(bufPtr);
|
||||
assert((size_t)toRead == statePtr->bufSize);
|
||||
assert((Tcl_Size)toRead == statePtr->bufSize);
|
||||
|
||||
if (statePtr->inQueueTail == NULL) {
|
||||
statePtr->inQueueHead = bufPtr;
|
||||
@@ -7985,7 +7981,7 @@ Tcl_GetChannelOption(
|
||||
Tcl_DStringAppendElement(dsPtr, "-profile");
|
||||
}
|
||||
/* Note currently input and output profiles are same */
|
||||
profile = CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags);
|
||||
profile = ENCODING_PROFILE_GET(statePtr->inputEncodingFlags);
|
||||
profileName = TclEncodingProfileIdToName(interp, profile);
|
||||
if (profileName == NULL) {
|
||||
return TCL_ERROR;
|
||||
@@ -8180,11 +8176,11 @@ Tcl_SetChannelOption(
|
||||
|
||||
if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) {
|
||||
encoding = Tcl_GetEncoding(NULL, "iso8859-1");
|
||||
CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags
|
||||
,CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags)
|
||||
ENCODING_PROFILE_SET(statePtr->inputEncodingFlags
|
||||
,ENCODING_PROFILE_GET(statePtr->inputEncodingFlags)
|
||||
|TCL_ENCODING_PROFILE_STRICT);
|
||||
CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags
|
||||
,CHANNEL_PROFILE_GET(statePtr->outputEncodingFlags)
|
||||
ENCODING_PROFILE_SET(statePtr->outputEncodingFlags
|
||||
,ENCODING_PROFILE_GET(statePtr->outputEncodingFlags)
|
||||
|TCL_ENCODING_PROFILE_STRICT);
|
||||
} else {
|
||||
encoding = Tcl_GetEncoding(interp, newValue);
|
||||
@@ -8207,20 +8203,18 @@ Tcl_SetChannelOption(
|
||||
Tcl_FreeEncoding(statePtr->encoding);
|
||||
statePtr->encoding = encoding;
|
||||
statePtr->inputEncodingState = NULL;
|
||||
profile = CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags);
|
||||
profile = ENCODING_PROFILE_GET(statePtr->inputEncodingFlags);
|
||||
statePtr->inputEncodingFlags = TCL_ENCODING_START;
|
||||
CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags, profile);
|
||||
ENCODING_PROFILE_SET(statePtr->inputEncodingFlags, profile);
|
||||
statePtr->outputEncodingState = NULL;
|
||||
statePtr->outputEncodingFlags = TCL_ENCODING_START;
|
||||
CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags, profile); /* Same as input */
|
||||
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];
|
||||
@@ -8229,7 +8223,7 @@ Tcl_SetChannelOption(
|
||||
if (interp) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"bad value for -eofchar: must be non-NUL ASCII"
|
||||
" character", -1));
|
||||
" character", TCL_INDEX_NONE));
|
||||
}
|
||||
Tcl_Free((void *)argv);
|
||||
return TCL_ERROR;
|
||||
@@ -8255,8 +8249,8 @@ Tcl_SetChannelOption(
|
||||
if (TclEncodingProfileNameToId(interp, newValue, &profile) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags, profile);
|
||||
CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags, profile);
|
||||
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")) {
|
||||
@@ -8294,11 +8288,11 @@ Tcl_SetChannelOption(
|
||||
statePtr->inEofChar = 0;
|
||||
Tcl_FreeEncoding(statePtr->encoding);
|
||||
statePtr->encoding = Tcl_GetEncoding(NULL, "iso8859-1");
|
||||
CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags
|
||||
,CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags)
|
||||
ENCODING_PROFILE_SET(statePtr->inputEncodingFlags
|
||||
,ENCODING_PROFILE_GET(statePtr->inputEncodingFlags)
|
||||
|TCL_ENCODING_PROFILE_STRICT);
|
||||
CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags
|
||||
,CHANNEL_PROFILE_GET(statePtr->outputEncodingFlags)
|
||||
ENCODING_PROFILE_SET(statePtr->outputEncodingFlags
|
||||
,ENCODING_PROFILE_GET(statePtr->outputEncodingFlags)
|
||||
|TCL_ENCODING_PROFILE_STRICT);
|
||||
} else if (strcmp(readMode, "lf") == 0) {
|
||||
translation = TCL_TRANSLATE_LF;
|
||||
@@ -8349,11 +8343,11 @@ Tcl_SetChannelOption(
|
||||
statePtr->outputTranslation = TCL_TRANSLATE_LF;
|
||||
Tcl_FreeEncoding(statePtr->encoding);
|
||||
statePtr->encoding = Tcl_GetEncoding(NULL, "iso8859-1");
|
||||
CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags
|
||||
,CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags)
|
||||
ENCODING_PROFILE_SET(statePtr->inputEncodingFlags
|
||||
,ENCODING_PROFILE_GET(statePtr->inputEncodingFlags)
|
||||
|TCL_ENCODING_PROFILE_STRICT);
|
||||
CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags
|
||||
,CHANNEL_PROFILE_GET(statePtr->outputEncodingFlags)
|
||||
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;
|
||||
@@ -10217,7 +10211,7 @@ DoRead(
|
||||
== (CHANNEL_EOF|CHANNEL_BLOCKED)));
|
||||
UpdateInterest(chanPtr);
|
||||
TclChannelRelease((Tcl_Channel)chanPtr);
|
||||
return (int)(p - dst);
|
||||
return (Tcl_Size)(p - dst);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -10280,8 +10274,8 @@ Lossless(
|
||||
(
|
||||
toRead == -1
|
||||
&& inStatePtr->encoding == outStatePtr->encoding
|
||||
&& CHANNEL_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8
|
||||
&& CHANNEL_PROFILE_GET(outStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8
|
||||
&& ENCODING_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8
|
||||
&& ENCODING_PROFILE_GET(outStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8
|
||||
)
|
||||
);
|
||||
}
|
||||
@@ -10654,7 +10648,7 @@ Tcl_IsChannelShared(
|
||||
ChannelState *statePtr = ((Channel *) chan)->state;
|
||||
/* State of real channel structure. */
|
||||
|
||||
return ((statePtr->refCount + 1 > 2) ? 1 : 0);
|
||||
return ((statePtr->refCount > 1) ? 1 : 0);
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
@@ -158,10 +158,6 @@ typedef struct ChannelState {
|
||||
* of line sequences in output? */
|
||||
int inEofChar; /* If nonzero, use this as a signal of EOF on
|
||||
* input. */
|
||||
#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. */
|
||||
@@ -288,13 +284,6 @@ typedef struct ChannelState {
|
||||
#define CHANNEL_CLOSEDWRITE (1<<21) /* Channel write side has been closed.
|
||||
* No further Tcl-level write IO on
|
||||
* the channel is allowed. */
|
||||
#define CHANNEL_PROFILE_MASK 0xFF000000
|
||||
#define CHANNEL_PROFILE_GET(flags_) ((flags_) & CHANNEL_PROFILE_MASK)
|
||||
#define CHANNEL_PROFILE_SET(flags_, profile_) \
|
||||
do { \
|
||||
(flags_) &= ~CHANNEL_PROFILE_MASK; \
|
||||
(flags_) |= profile_; \
|
||||
} while (0)
|
||||
|
||||
/*
|
||||
* The length of time to wait between synthetic timer events. Must be zero or
|
||||
|
||||
+19
-7
@@ -283,7 +283,7 @@ Tcl_GetsObjCmd(
|
||||
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;
|
||||
Tcl_Obj *linePtr, *chanObjPtr, *resultDictPtr, *returnOptsPtr;
|
||||
int code = TCL_OK;
|
||||
|
||||
if ((objc != 2) && (objc != 3)) {
|
||||
@@ -306,7 +306,6 @@ Tcl_GetsObjCmd(
|
||||
lineLen = Tcl_GetsObj(chan, linePtr);
|
||||
if (lineLen == TCL_IO_FAILURE) {
|
||||
if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
|
||||
Tcl_DecrRefCount(linePtr);
|
||||
|
||||
/*
|
||||
* TIP #219.
|
||||
@@ -320,7 +319,14 @@ Tcl_GetsObjCmd(
|
||||
"error reading \"%s\": %s",
|
||||
TclGetString(chanObjPtr), Tcl_PosixError(interp)));
|
||||
}
|
||||
resultDictPtr = Tcl_NewDictObj();
|
||||
Tcl_DictObjPut(NULL, resultDictPtr, Tcl_NewStringObj("read", -1)
|
||||
, linePtr);
|
||||
returnOptsPtr = Tcl_NewDictObj();
|
||||
Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-result", -1)
|
||||
, resultDictPtr);
|
||||
code = TCL_ERROR;
|
||||
Tcl_SetReturnOptions(interp, returnOptsPtr);
|
||||
goto done;
|
||||
}
|
||||
lineLen = TCL_IO_FAILURE;
|
||||
@@ -371,7 +377,7 @@ Tcl_ReadObjCmd(
|
||||
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;
|
||||
Tcl_Obj *resultPtr, *resultDictPtr, *returnOptsPtr, *chanObjPtr;
|
||||
|
||||
if ((objc != 2) && (objc != 3)) {
|
||||
Interp *iPtr;
|
||||
@@ -433,7 +439,6 @@ Tcl_ReadObjCmd(
|
||||
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
|
||||
@@ -446,7 +451,14 @@ Tcl_ReadObjCmd(
|
||||
"error reading \"%s\": %s",
|
||||
TclGetString(chanObjPtr), Tcl_PosixError(interp)));
|
||||
}
|
||||
resultDictPtr = Tcl_NewDictObj();
|
||||
Tcl_DictObjPut(NULL, resultDictPtr, Tcl_NewStringObj("read", -1)
|
||||
, resultPtr);
|
||||
returnOptsPtr = Tcl_NewDictObj();
|
||||
Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-result", -1)
|
||||
, resultDictPtr);
|
||||
TclChannelRelease(chan);
|
||||
Tcl_SetReturnOptions(interp, returnOptsPtr);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
@@ -698,7 +710,7 @@ Tcl_CloseObjCmd(
|
||||
|
||||
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
|
||||
const char *string;
|
||||
size_t len;
|
||||
Tcl_Size len;
|
||||
|
||||
if (Tcl_IsShared(resultPtr)) {
|
||||
resultPtr = Tcl_DuplicateObj(resultPtr);
|
||||
@@ -858,7 +870,7 @@ Tcl_ExecObjCmd(
|
||||
const char *string;
|
||||
Tcl_Channel chan;
|
||||
int argc, background, i, index, keepNewline, result, skip, ignoreStderr;
|
||||
size_t length;
|
||||
Tcl_Size length;
|
||||
static const char *const options[] = {
|
||||
"-ignorestderr", "-keepnewline", "--", NULL
|
||||
};
|
||||
@@ -1788,9 +1800,9 @@ ChanPendingObjCmd(
|
||||
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;
|
||||
int mode;
|
||||
|
||||
if (objc != 3) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "mode channelId");
|
||||
|
||||
+12
-3
@@ -375,11 +375,15 @@ ExecuteCallback(
|
||||
* interpreters. */
|
||||
{
|
||||
Tcl_Obj *resObj; /* See below, switch (transmit). */
|
||||
size_t resLen = 0;
|
||||
Tcl_Size resLen = 0;
|
||||
unsigned char *resBuf;
|
||||
Tcl_InterpState state = NULL;
|
||||
int res = TCL_OK;
|
||||
Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);
|
||||
Tcl_Obj *command = TclDuplicatePureObj(
|
||||
interp, dataPtr->command, tclListType);
|
||||
if (!command) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_Interp *eval = dataPtr->interp;
|
||||
|
||||
Tcl_Preserve(eval);
|
||||
@@ -397,7 +401,12 @@ ExecuteCallback(
|
||||
}
|
||||
|
||||
Tcl_IncrRefCount(command);
|
||||
Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1));
|
||||
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
|
||||
|
||||
+11
-4
@@ -580,6 +580,9 @@ TclChanCreateObjCmd(
|
||||
|
||||
rcId = NextHandle();
|
||||
rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId);
|
||||
if (!rcPtr) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Invoke 'initialize' and validate that the handler is present and ok.
|
||||
@@ -2258,8 +2261,10 @@ NewReflectedChannel(
|
||||
rcPtr->mode = mode;
|
||||
rcPtr->interest = 0; /* Initially no interest registered */
|
||||
|
||||
/* ASSERT: cmdpfxObj is a Tcl List */
|
||||
rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
|
||||
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) {
|
||||
@@ -2396,8 +2401,10 @@ InvokeTclMethod(
|
||||
* before the channel id.
|
||||
*/
|
||||
|
||||
cmd = TclListObjCopy(NULL, rcPtr->cmd);
|
||||
|
||||
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);
|
||||
|
||||
+11
-11
@@ -264,7 +264,7 @@ 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,
|
||||
Tcl_Size size; /* I: #bytes to transform,
|
||||
* O: #bytes in the transform result */
|
||||
};
|
||||
struct ForwardParamLimit {
|
||||
@@ -2004,7 +2004,7 @@ InvokeTclMethod(
|
||||
*/
|
||||
if (result != TCL_ERROR) {
|
||||
Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv);
|
||||
size_t cmdLen;
|
||||
Tcl_Size cmdLen;
|
||||
const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
|
||||
|
||||
Tcl_IncrRefCount(cmd);
|
||||
@@ -2562,7 +2562,7 @@ ForwardProc(
|
||||
* Sent it back to the request originator.
|
||||
*/
|
||||
|
||||
size_t bytec = 0; /* Number of returned bytes */
|
||||
Tcl_Size bytec = 0; /* Number of returned bytes */
|
||||
unsigned char *bytev;
|
||||
/* Array of returned bytes */
|
||||
|
||||
@@ -2596,7 +2596,7 @@ ForwardProc(
|
||||
* Sent it back to the request originator.
|
||||
*/
|
||||
|
||||
size_t bytec = 0; /* Number of returned bytes */
|
||||
Tcl_Size bytec = 0; /* Number of returned bytes */
|
||||
unsigned char *bytev;
|
||||
/* Array of returned bytes */
|
||||
|
||||
@@ -2626,7 +2626,7 @@ ForwardProc(
|
||||
* Sent it back to the request originator.
|
||||
*/
|
||||
|
||||
size_t bytec = 0; /* Number of returned bytes */
|
||||
Tcl_Size bytec = 0; /* Number of returned bytes */
|
||||
unsigned char *bytev; /* Array of returned bytes */
|
||||
|
||||
bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
|
||||
@@ -2652,7 +2652,7 @@ ForwardProc(
|
||||
* Sent it back to the request originator.
|
||||
*/
|
||||
|
||||
size_t bytec = 0; /* Number of returned bytes */
|
||||
Tcl_Size bytec = 0; /* Number of returned bytes */
|
||||
unsigned char *bytev;
|
||||
/* Array of returned bytes */
|
||||
|
||||
@@ -2770,7 +2770,7 @@ ForwardSetObjError(
|
||||
ForwardParam *paramPtr,
|
||||
Tcl_Obj *obj)
|
||||
{
|
||||
size_t len;
|
||||
Tcl_Size len;
|
||||
const char *msgStr = Tcl_GetStringFromObj(obj, &len);
|
||||
|
||||
len++;
|
||||
@@ -3045,7 +3045,7 @@ TransformRead(
|
||||
Tcl_Obj *bufObj)
|
||||
{
|
||||
Tcl_Obj *resObj;
|
||||
size_t bytec = 0; /* Number of returned bytes */
|
||||
Tcl_Size bytec = 0; /* Number of returned bytes */
|
||||
unsigned char *bytev; /* Array of returned bytes */
|
||||
|
||||
/*
|
||||
@@ -3100,7 +3100,7 @@ TransformWrite(
|
||||
{
|
||||
Tcl_Obj *bufObj;
|
||||
Tcl_Obj *resObj;
|
||||
size_t bytec = 0; /* Number of returned bytes */
|
||||
Tcl_Size bytec = 0; /* Number of returned bytes */
|
||||
unsigned char *bytev; /* Array of returned bytes */
|
||||
int res;
|
||||
|
||||
@@ -3167,7 +3167,7 @@ TransformDrain(
|
||||
int *errorCodePtr)
|
||||
{
|
||||
Tcl_Obj *resObj;
|
||||
size_t bytec = 0; /* Number of returned bytes */
|
||||
Tcl_Size bytec = 0; /* Number of returned bytes */
|
||||
unsigned char *bytev; /* Array of returned bytes */
|
||||
|
||||
/*
|
||||
@@ -3216,7 +3216,7 @@ TransformFlush(
|
||||
int op)
|
||||
{
|
||||
Tcl_Obj *resObj;
|
||||
size_t bytec = 0; /* Number of returned bytes */
|
||||
Tcl_Size bytec = 0; /* Number of returned bytes */
|
||||
unsigned char *bytev; /* Array of returned bytes */
|
||||
int res;
|
||||
|
||||
|
||||
+11
-6
@@ -521,7 +521,7 @@ TclFSCwdPointerEquals(
|
||||
if (tsdPtr->cwdPathPtr == *pathPtrPtr) {
|
||||
return 1;
|
||||
} else {
|
||||
size_t len1, len2;
|
||||
Tcl_Size len1, len2;
|
||||
const char *str1, *str2;
|
||||
|
||||
str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
|
||||
@@ -663,7 +663,7 @@ FsUpdateCwd(
|
||||
Tcl_Obj *cwdObj,
|
||||
void *clientData)
|
||||
{
|
||||
size_t len = 0;
|
||||
Tcl_Size len = 0;
|
||||
const char *str = NULL;
|
||||
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
|
||||
|
||||
@@ -1324,7 +1324,7 @@ TclFSNormalizeToUniquePath(
|
||||
{
|
||||
FilesystemRecord *fsRecPtr, *firstFsRecPtr;
|
||||
|
||||
size_t i;
|
||||
Tcl_Size i;
|
||||
int isVfsPath = 0;
|
||||
const char *path;
|
||||
|
||||
@@ -1686,7 +1686,7 @@ Tcl_FSEvalFileEx(
|
||||
const char *encodingName) /* Either the name of an encoding or NULL to
|
||||
use the utf-8 encoding. */
|
||||
{
|
||||
size_t length;
|
||||
Tcl_Size length;
|
||||
int result = TCL_ERROR;
|
||||
Tcl_StatBuf statBuf;
|
||||
Tcl_Obj *oldScriptFile;
|
||||
@@ -1734,6 +1734,11 @@ Tcl_FSEvalFileEx(
|
||||
Tcl_CloseEx(interp,chan,0);
|
||||
return result;
|
||||
}
|
||||
if (Tcl_SetChannelOption(interp, chan, "-profile", "strict")
|
||||
!= TCL_OK) {
|
||||
Tcl_CloseEx(interp,chan,0);
|
||||
return result;
|
||||
}
|
||||
|
||||
TclNewObj(objPtr);
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
@@ -1952,7 +1957,7 @@ EvalFileCallback(
|
||||
* Record information about where the error occurred.
|
||||
*/
|
||||
|
||||
size_t length;
|
||||
Tcl_Size length;
|
||||
const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
|
||||
const unsigned int limit = 150;
|
||||
int overflow = (length > limit);
|
||||
@@ -2794,7 +2799,7 @@ Tcl_FSGetCwd(
|
||||
* infinite loop bug when trying to normalize tsdPtr->cwdPathPtr.
|
||||
*/
|
||||
|
||||
size_t len1, len2;
|
||||
Tcl_Size len1, len2;
|
||||
const char *str1, *str2;
|
||||
|
||||
str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
|
||||
|
||||
@@ -537,7 +537,7 @@ declare 214 {
|
||||
void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding)
|
||||
}
|
||||
declare 215 {
|
||||
void *TclStackAlloc(Tcl_Interp *interp, Tcl_Size numBytes)
|
||||
void *TclStackAlloc(Tcl_Interp *interp, TCL_HASH_TYPE numBytes)
|
||||
}
|
||||
declare 216 {
|
||||
void TclStackFree(Tcl_Interp *interp, void *freePtr)
|
||||
|
||||
+393
-151
@@ -11,6 +11,7 @@
|
||||
* Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
|
||||
* Copyright (c) 2006-2008 by Joe Mistachkin. All rights reserved.
|
||||
* Copyright (c) 2008 by Miguel Sofer. All rights reserved.
|
||||
* Copyright (c) 2021 by Nathan Coulter. All rights reserved.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
@@ -46,10 +47,13 @@
|
||||
|
||||
#if defined(__cplusplus)
|
||||
# define TCL_UNUSED(T) T
|
||||
# define TCL_UNUSEDVAR(T) T
|
||||
#elif defined(__GNUC__) && (__GNUC__ > 2)
|
||||
# define TCL_UNUSED(T) T JOIN(dummy, __LINE__) __attribute__((unused))
|
||||
# define TCL_UNUSEDVAR(T) T __attribute__((unused))
|
||||
#else
|
||||
# define TCL_UNUSED(T) T JOIN(dummy, __LINE__)
|
||||
# define TCL_UNUSEDVAR(T) T
|
||||
#endif
|
||||
|
||||
/*
|
||||
@@ -104,12 +108,6 @@
|
||||
# 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*(Tcl_Size)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
|
||||
@@ -212,6 +210,223 @@ typedef struct Tcl_ResolverInfo {
|
||||
|
||||
#define TCL_AVOID_RESOLVERS 0x40000
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
* Object type
|
||||
*----------------------------------------------------------------
|
||||
*/
|
||||
|
||||
/* version is a pointer so that it can be overridden if ever needed */
|
||||
typedef struct TclObjectTypeType {
|
||||
int *version;
|
||||
} TclObjectTypeType;
|
||||
|
||||
|
||||
/* keep this structure in sync with Tcl_ObjType */
|
||||
typedef struct ObjectType {
|
||||
const char *name; /* Name of the type, e.g. "int". */
|
||||
Tcl_FreeInternalRepProc *freeIntRepProc;
|
||||
/* Called to free any storage for the type's
|
||||
* internal rep. NULL if the internal rep does
|
||||
* not need freeing. */
|
||||
Tcl_DupInternalRepProc *dupIntRepProc;
|
||||
/* Called to create a new object as a copy of
|
||||
* an existing object. */
|
||||
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. */
|
||||
int version;
|
||||
Tcl_ObjInterface *interface;
|
||||
} ObjectType;
|
||||
|
||||
#define TclObjectInterfaceCall(objPtr, iface, proc, ...) \
|
||||
((ObjInterface *)((ObjectType *)(objPtr)->typePtr)->interface) \
|
||||
->iface.proc(__VA_ARGS__)
|
||||
|
||||
#define TclObjectDispatch(objPtr, default, iface, proc, ...) \
|
||||
TclObjectHasInterface((objPtr), iface, proc) \
|
||||
? TclObjectInterfaceCall(objPtr, iface, proc, __VA_ARGS__) \
|
||||
: default(__VA_ARGS__)
|
||||
|
||||
|
||||
#define TclObjectDispatchNoDefault(interp, res, objPtr, iface, proc, ...) \
|
||||
(TclObjectHasInterface((objPtr), iface, proc) \
|
||||
? (res = TclObjectInterfaceCall((objPtr), iface, proc, __VA_ARGS__), \
|
||||
TCL_OK) \
|
||||
: (Tcl_SetObjResult((interp), \
|
||||
Tcl_ObjPrintf("interface not provided interface %s proc %s" \
|
||||
, #iface, #proc )), TCL_ERROR))
|
||||
|
||||
|
||||
#define TclObjectHasInterface(objPtr, iface, proc) \
|
||||
((objPtr)->typePtr != NULL \
|
||||
&& (objPtr)->typePtr->version == 2 \
|
||||
&& ((ObjInterface *)((ObjectType *)(objPtr)->typePtr)->interface) \
|
||||
->iface.proc != NULL)
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
* Object interface data structures and macros
|
||||
*----------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#define tclObjTypeInterfaceArgsListAll \
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */ \
|
||||
Tcl_Obj *listPtr, /* List object for which an element array \
|
||||
* is to be returned. */ \
|
||||
Tcl_Size *objcPtr, /* Where to store the count of objects \
|
||||
* referenced by objv. */ \
|
||||
Tcl_Obj ***objvPtr /* Where to store the pointer to an \
|
||||
* array of */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListAppend \
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */ \
|
||||
Tcl_Obj *listPtr, /* List object to append objPtr to. */ \
|
||||
Tcl_Obj *objPtr /* Object to append to listPtr's list. */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListAppendList \
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */ \
|
||||
Tcl_Obj *listPtr, /* List object to append elements to. */ \
|
||||
Tcl_Obj *elemListPtr /* List obj with elements to append. */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListIndex \
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */ \
|
||||
Tcl_Obj *listPtr, /* List object to index into. */ \
|
||||
Tcl_Size index, /* Index of element to return. */ \
|
||||
Tcl_Obj **objPtrPtr /* The resulting Tcl_Obj* is stored here. */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListIndexEnd \
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */ \
|
||||
Tcl_Obj *listPtr, /* List object to index into. */ \
|
||||
Tcl_Size index, /* Index of element to return. */ \
|
||||
Tcl_Obj **objPtrPtr /* The resulting Tcl_Obj* is stored here. */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListIsSorted \
|
||||
Tcl_Interp * interp, /* Used to report errors */ \
|
||||
Tcl_Obj *listPtr, /* The list in question */ \
|
||||
size_t flags /* flags */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListLength \
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */ \
|
||||
Tcl_Obj *listPtr, /* List object whose #elements to return. */ \
|
||||
Tcl_Size *lenPtr /* The resulting length is stored here. */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListRange \
|
||||
Tcl_Interp * interp, /* Used to report errors */ \
|
||||
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. */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListRangeEnd \
|
||||
Tcl_Interp * interp, /* Used to report errors */ \
|
||||
Tcl_Obj *listPtr, /* List object to take a range from. */ \
|
||||
Tcl_Size fromAnchor,/* 0 for start and 1 for end */ \
|
||||
Tcl_Size fromIdx, /* Index of first element to include. */ \
|
||||
Tcl_Size toAnchor, /* 0 for start and 1 for end */ \
|
||||
Tcl_Size toIdx /* Index of last element to include. */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListReplace \
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
|
||||
Tcl_Obj *listObj, /* 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. */ \
|
||||
/* An array of objc pointers to Tcl \
|
||||
* objects to insert. */ \
|
||||
Tcl_Obj *const insertObjs[]
|
||||
|
||||
#define tclObjTypeInterfaceArgsListReplaceList \
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
|
||||
Tcl_Obj *listPtr, /* List object whose elements to replace. */ \
|
||||
Tcl_Size first, /* Index of first element to replace. */ \
|
||||
Tcl_Size count, /* Number of elements to replace. */ \
|
||||
Tcl_Obj *newItemsPtr /* a list of new items to insert */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListReverse \
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
|
||||
Tcl_Obj *listPtr /* List object whose elements to replace. */ \
|
||||
|
||||
|
||||
#define tclObjTypeInterfaceArgsListSet \
|
||||
Tcl_Interp *interp, /* Tcl interpreter; used for error reporting \
|
||||
* if not NULL. */ \
|
||||
Tcl_Obj *listObj, /* List object in which element should be \
|
||||
* stored. */ \
|
||||
Tcl_Size index, /* Index of element to store. */ \
|
||||
Tcl_Obj *valueObj /* Tcl object to store in the designated list \
|
||||
* element. */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListSetList \
|
||||
Tcl_Interp *interp, /* Tcl interpreter. */ \
|
||||
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'. */
|
||||
|
||||
|
||||
#define tclObjTypeInterfaceArgsStringIndex \
|
||||
Tcl_Interp *interp, \
|
||||
Tcl_Obj *objPtr, \
|
||||
Tcl_Size index, \
|
||||
Tcl_Obj **objPtrPtr /* The resulting Tcl_Obj* is stored here. */
|
||||
|
||||
|
||||
#define tclObjTypeInterfaceArgsStringIndexEnd \
|
||||
Tcl_Interp *interp, \
|
||||
Tcl_Obj *objPtr, \
|
||||
Tcl_Size index, \
|
||||
Tcl_Obj **objPtrPtr /* The resulting Tcl_Obj* is stored here. */
|
||||
|
||||
|
||||
#define tclObjTypeInterfaceArgsStringLength \
|
||||
Tcl_Obj *objPtr
|
||||
|
||||
|
||||
#define tclObjTypeInterfaceArgsStringRange \
|
||||
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. */
|
||||
|
||||
|
||||
#define tclObjTypeInterfaceArgsStringRangeEnd \
|
||||
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. */
|
||||
|
||||
|
||||
typedef struct ObjInterface {
|
||||
int version;
|
||||
struct string {
|
||||
int (*index)(tclObjTypeInterfaceArgsStringIndex);
|
||||
int (*indexEnd)(tclObjTypeInterfaceArgsStringIndexEnd);
|
||||
Tcl_Size (*length)(tclObjTypeInterfaceArgsStringLength);
|
||||
Tcl_Obj* (*range)(tclObjTypeInterfaceArgsStringRange);
|
||||
Tcl_Obj* (*rangeEnd)(tclObjTypeInterfaceArgsStringRangeEnd);
|
||||
} string;
|
||||
struct list {
|
||||
int (*all)(tclObjTypeInterfaceArgsListAll);
|
||||
int (*append)(tclObjTypeInterfaceArgsListAppend);
|
||||
int (*appendlist)(tclObjTypeInterfaceArgsListAppendList);
|
||||
int (*index)(tclObjTypeInterfaceArgsListIndex);
|
||||
int (*indexEnd)(tclObjTypeInterfaceArgsListIndexEnd);
|
||||
int (*isSorted)(tclObjTypeInterfaceArgsListIsSorted);
|
||||
int (*length)(tclObjTypeInterfaceArgsListLength);
|
||||
Tcl_Obj* (*range)(tclObjTypeInterfaceArgsListRange);
|
||||
Tcl_Obj* (*rangeEnd)(tclObjTypeInterfaceArgsListRangeEnd);
|
||||
int (*replace)(tclObjTypeInterfaceArgsListReplace);
|
||||
int (*replaceList)(tclObjTypeInterfaceArgsListReplaceList);
|
||||
Tcl_Obj* (*reverse)(tclObjTypeInterfaceArgsListReverse);
|
||||
int (*set)(tclObjTypeInterfaceArgsListSet);
|
||||
Tcl_Obj * (*setlist)(tclObjTypeInterfaceArgsListSetList);
|
||||
} list;
|
||||
} ObjInterface;
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
* Data structures related to namespaces.
|
||||
@@ -231,9 +446,7 @@ typedef struct NamespacePathEntry NamespacePathEntry;
|
||||
typedef struct TclVarHashTable {
|
||||
Tcl_HashTable table;
|
||||
struct Namespace *nsPtr;
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
struct Var *arrayPtr;
|
||||
#endif /* TCL_MAJOR_VERSION > 8 */
|
||||
} TclVarHashTable;
|
||||
|
||||
/*
|
||||
@@ -283,11 +496,7 @@ typedef struct Namespace {
|
||||
* strings; values have type (Namespace *). If
|
||||
* NULL, there are no children. */
|
||||
#endif
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
size_t nsId; /* Unique id for the namespace. */
|
||||
#else
|
||||
unsigned long nsId;
|
||||
#endif
|
||||
Tcl_Interp *interp; /* The interpreter containing this
|
||||
* namespace. */
|
||||
int flags; /* OR-ed combination of the namespace status
|
||||
@@ -968,9 +1177,6 @@ typedef struct CompiledLocal {
|
||||
* Among others used to speed up var lookups. */
|
||||
Tcl_Size frameIndex; /* Index in the array of compiler-assigned
|
||||
* variables in the procedure call frame. */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
int flags;
|
||||
#endif
|
||||
Tcl_Obj *defValuePtr; /* Pointer to the default value of an
|
||||
* argument, if any. NULL if not an argument
|
||||
* or, if an argument, no default value. */
|
||||
@@ -981,12 +1187,10 @@ typedef struct CompiledLocal {
|
||||
* is marked by a unique tag during
|
||||
* compilation, and that same tag is used to
|
||||
* find the variable at runtime. */
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
int flags; /* Flag bits for the local variable. Same as
|
||||
* the flags for the Var structure above,
|
||||
* although only VAR_ARGUMENT, VAR_TEMPORARY,
|
||||
* and VAR_RESOLVED make sense. */
|
||||
#endif
|
||||
char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If
|
||||
* the name is NULL, this will just be '\0'.
|
||||
* The actual size of this field will be large
|
||||
@@ -1044,11 +1248,7 @@ typedef void (ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj);
|
||||
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
|
||||
@@ -1092,20 +1292,6 @@ typedef struct ActiveInterpTrace {
|
||||
#define TCL_TRACE_ENTER_EXEC 1
|
||||
#define TCL_TRACE_LEAVE_EXEC 2
|
||||
|
||||
typedef struct { /* For internal core use only */
|
||||
Tcl_ObjType objType;
|
||||
struct {
|
||||
Tcl_Size (*lengthProc)(Tcl_Obj *obj);
|
||||
} abstractList;
|
||||
} TclObjTypeWithAbstractList;
|
||||
#define TCL_OBJTYPE_V0_1(lengthProc) (sizeof(TclObjTypeWithAbstractList)) \
|
||||
}, {lengthProc /* For internal core use only */
|
||||
#define ABSTRACTLIST_PROC(objPtr, proc) (((objPtr)->typePtr \
|
||||
&& ((objPtr)->typePtr->version > offsetof(TclObjTypeWithAbstractList, abstractList.proc))) ? \
|
||||
((const TclObjTypeWithAbstractList *)(objPtr)->typePtr)->abstractList.proc : NULL)
|
||||
|
||||
MODULE_SCOPE Tcl_Size TclLengthOne(Tcl_Obj *);
|
||||
|
||||
/*
|
||||
* 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
|
||||
@@ -1887,18 +2073,7 @@ typedef struct Interp {
|
||||
void *interpInfo; /* Information used by tclInterp.c to keep
|
||||
* track of parent/child interps on a
|
||||
* per-interp basis. */
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
void (*optimizer)(void *envPtr);
|
||||
#else
|
||||
union {
|
||||
void (*optimizer)(void *envPtr);
|
||||
Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The
|
||||
* unused space in interp was repurposed for
|
||||
* pluggable bytecode optimizers. The core
|
||||
* contains one optimizer, which can be
|
||||
* selectively overridden by extensions. */
|
||||
} extra;
|
||||
#endif
|
||||
/*
|
||||
* Information related to procedures and variables. See tclProc.c and
|
||||
* tclVar.c for usage.
|
||||
@@ -1927,12 +2102,6 @@ typedef struct Interp {
|
||||
Namespace *lookupNsPtr; /* Namespace to use ONLY on the next
|
||||
* TCL_EVAL_INVOKE call to Tcl_EvalObjv. */
|
||||
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
char *appendResultDontUse;
|
||||
int appendAvlDontUse;
|
||||
int appendUsedDontUse;
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Information about packages. Used only in tclPkg.c.
|
||||
*/
|
||||
@@ -1955,9 +2124,6 @@ typedef struct Interp {
|
||||
* Normally zero, but may be set before
|
||||
* calling Tcl_Eval. See below for valid
|
||||
* values. */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
int unused1; /* No longer used (was termOffset) */
|
||||
#endif
|
||||
LiteralTable literalTable; /* Contains LiteralEntry's describing all Tcl
|
||||
* objects holding literals of scripts
|
||||
* compiled by the interpreter. Indexed by the
|
||||
@@ -1995,9 +2161,6 @@ typedef struct Interp {
|
||||
* string. Returned by Tcl_ObjSetVar2 when
|
||||
* variable traces change a variable in a
|
||||
* gross way. */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1];
|
||||
#endif
|
||||
Tcl_Obj *objResultPtr; /* If the last command returned an object
|
||||
* result, this points to it. Should not be
|
||||
* accessed directly; see comment above. */
|
||||
@@ -2451,15 +2614,6 @@ typedef enum TclEolTranslation {
|
||||
#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 --
|
||||
@@ -2501,7 +2655,8 @@ typedef struct ListStore {
|
||||
|
||||
/* Max number of elements that can be contained in a list */
|
||||
#define LIST_MAX \
|
||||
((Tcl_Size)((ListSizeT_MAX - offsetof(ListStore, slots)) / sizeof(Tcl_Obj *)))
|
||||
((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 *))))
|
||||
@@ -2513,7 +2668,7 @@ typedef struct ListStore {
|
||||
typedef struct ListSpan {
|
||||
Tcl_Size spanStart; /* Starting index of the span */
|
||||
Tcl_Size spanLength; /* Number of elements in the span */
|
||||
Tcl_Size refCount; /* Count of references to this span record */
|
||||
size_t refCount; /* Count of references to this span record */
|
||||
} ListSpan;
|
||||
#ifndef LIST_SPAN_THRESHOLD /* May be set on build line */
|
||||
#define LIST_SPAN_THRESHOLD 101
|
||||
@@ -2593,6 +2748,7 @@ typedef struct ListRep {
|
||||
(((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,
|
||||
@@ -2627,10 +2783,10 @@ typedef struct ListRep {
|
||||
* converted to a list.
|
||||
*/
|
||||
#define TclListObjGetElementsM(interp_, listObj_, objcPtr_, objvPtr_) \
|
||||
(((listObj_)->typePtr == &tclListType.objType) \
|
||||
? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \
|
||||
TCL_OK) \
|
||||
: Tcl_ListObjGetElements( \
|
||||
(((listObj_)->typePtr == tclListType) \
|
||||
? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \
|
||||
TCL_OK) \
|
||||
: Tcl_ListObjGetElements( \
|
||||
(interp_), (listObj_), (objcPtr_), (objvPtr_)))
|
||||
|
||||
/*
|
||||
@@ -2638,13 +2794,14 @@ typedef struct ListRep {
|
||||
* count in lenPtr_. Returns TCL_OK on success or TCL_ERROR if the
|
||||
* Tcl_Obj cannot be converted to a list.
|
||||
*/
|
||||
#define TclListObjLengthM(interp_, listObj_, lenPtr_) \
|
||||
(((listObj_)->typePtr == &tclListType.objType) \
|
||||
? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \
|
||||
#define TclListObjLengthM(interp_, listObj_, lenPtr_) \
|
||||
(((listObj_)->typePtr == tclListType) \
|
||||
? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \
|
||||
: Tcl_ListObjLength((interp_), (listObj_), (lenPtr_)))
|
||||
|
||||
#define TclListObjIsCanonical(listObj_) \
|
||||
(((listObj_)->typePtr == &tclListType.objType) ? ListObjIsCanonical((listObj_)) : 0)
|
||||
#define TclListObjIsCanonical(listObj_) \
|
||||
(((listObj_)->typePtr == tclListType) \
|
||||
? ListObjIsCanonical((listObj_)) : 0)
|
||||
|
||||
/*
|
||||
* Modes for collecting (or not) in the implementations of TclNRForeachCmd,
|
||||
@@ -2662,29 +2819,20 @@ typedef struct ListRep {
|
||||
* WARNING: these macros eval their args more than once.
|
||||
*/
|
||||
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
#define TclGetBooleanFromObj(interp, objPtr, intPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType.objType \
|
||||
|| (objPtr)->typePtr == &tclBooleanType.objType) \
|
||||
(((objPtr)->typePtr == tclIntType \
|
||||
|| (objPtr)->typePtr == tclBooleanType) \
|
||||
? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
|
||||
: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
|
||||
#else
|
||||
#define TclGetBooleanFromObj(interp, objPtr, intPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType.objType) \
|
||||
? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
|
||||
: ((objPtr)->typePtr == &tclBooleanType.objType) \
|
||||
? (*(intPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \
|
||||
: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
|
||||
#endif
|
||||
|
||||
#ifdef TCL_WIDE_INT_IS_LONG
|
||||
#define TclGetLongFromObj(interp, objPtr, longPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType.objType) \
|
||||
(((objPtr)->typePtr == tclIntType) \
|
||||
? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
|
||||
: Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
|
||||
#else
|
||||
#define TclGetLongFromObj(interp, objPtr, longPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType.objType \
|
||||
(((objPtr)->typePtr == tclIntType \
|
||||
&& (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \
|
||||
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \
|
||||
? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \
|
||||
@@ -2692,13 +2840,13 @@ typedef struct ListRep {
|
||||
#endif
|
||||
|
||||
#define TclGetIntFromObj(interp, objPtr, intPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType.objType \
|
||||
(((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.objType) && ((objPtr)->internalRep.wideValue >= 0) \
|
||||
((((objPtr)->typePtr == tclIntType) && ((objPtr)->internalRep.wideValue >= 0) \
|
||||
&& ((objPtr)->internalRep.wideValue <= endValue)) \
|
||||
? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
|
||||
: Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
|
||||
@@ -2712,7 +2860,7 @@ typedef struct ListRep {
|
||||
*/
|
||||
|
||||
#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType.objType) \
|
||||
(((objPtr)->typePtr == tclIntType) \
|
||||
? (*(wideIntPtr) = \
|
||||
((objPtr)->internalRep.wideValue), TCL_OK) : \
|
||||
Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
|
||||
@@ -2864,6 +3012,91 @@ typedef struct ProcessGlobalValue {
|
||||
#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.
|
||||
@@ -2902,13 +3135,13 @@ MODULE_SCOPE void *tclTimeClientData;
|
||||
* Variables denoting the Tcl object types defined in the core.
|
||||
*/
|
||||
|
||||
MODULE_SCOPE const TclObjTypeWithAbstractList tclBignumType;
|
||||
MODULE_SCOPE const TclObjTypeWithAbstractList tclBooleanType;
|
||||
MODULE_SCOPE const Tcl_ObjType *tclBignumType;
|
||||
MODULE_SCOPE const Tcl_ObjType *tclBooleanType;
|
||||
MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
|
||||
MODULE_SCOPE const TclObjTypeWithAbstractList tclDoubleType;
|
||||
MODULE_SCOPE const TclObjTypeWithAbstractList tclIntType;
|
||||
MODULE_SCOPE const TclObjTypeWithAbstractList tclListType;
|
||||
MODULE_SCOPE const TclObjTypeWithAbstractList tclArithSeriesType;
|
||||
MODULE_SCOPE const Tcl_ObjType *tclDoubleType;
|
||||
MODULE_SCOPE const Tcl_ObjType *tclIntType;
|
||||
MODULE_SCOPE const Tcl_ObjType *tclListType;
|
||||
MODULE_SCOPE const Tcl_ObjType *tclArithSeriesType;
|
||||
MODULE_SCOPE const Tcl_ObjType tclDictType;
|
||||
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
|
||||
MODULE_SCOPE const Tcl_ObjType tclStringType;
|
||||
@@ -3051,7 +3284,6 @@ struct Tcl_LoadHandle_ {
|
||||
*----------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#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,
|
||||
@@ -3075,6 +3307,7 @@ 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 void TclBounceRefCount(Tcl_Obj *objPtr);
|
||||
MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string,
|
||||
Tcl_Size strLen, const unsigned char *pattern,
|
||||
Tcl_Size ptnLen, int flags);
|
||||
@@ -3108,6 +3341,8 @@ MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
|
||||
Tcl_Namespace *ensembleNamespacePtr, int flags);
|
||||
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
|
||||
MODULE_SCOPE void TclDeleteNamespaceChildren(Namespace *nsPtr);
|
||||
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,
|
||||
@@ -3196,6 +3431,8 @@ MODULE_SCOPE int TclGetLoadedLibraries(Tcl_Interp *interp,
|
||||
const char *packageName);
|
||||
MODULE_SCOPE int TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *,
|
||||
Tcl_WideInt *);
|
||||
MODULE_SCOPE int TclIndexIsFromEnd(Tcl_Size encoded);
|
||||
MODULE_SCOPE Tcl_Size TclIndexLast (Tcl_Size N);
|
||||
MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
|
||||
Tcl_Obj *incrPtr);
|
||||
MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
|
||||
@@ -3234,20 +3471,23 @@ 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);
|
||||
MODULE_SCOPE int Tcl_LengthIsFinite(Tcl_Size length);
|
||||
/* TIP #280 */
|
||||
MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, Tcl_Size line, int n,
|
||||
int *lines, Tcl_Obj *const *elems);
|
||||
MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
|
||||
MODULE_SCOPE int (*TclObjInterfaceGetListIndex (Tcl_Obj *objPtr))
|
||||
(tclObjTypeInterfaceArgsListIndex);
|
||||
MODULE_SCOPE int TclListObjAppendElements(Tcl_Interp *interp,
|
||||
Tcl_Obj *toObj, Tcl_Size elemCount,
|
||||
Tcl_Obj *const elemObjv[]);
|
||||
MODULE_SCOPE Tcl_Obj * TclListObjRange(Tcl_Obj *listPtr, Tcl_Size fromIdx,
|
||||
Tcl_Size toIdx);
|
||||
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(tclObjTypeInterfaceArgsListSetList);
|
||||
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);
|
||||
@@ -3260,6 +3500,9 @@ 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 Tcl_Obj * TclObjGetScalar(Tcl_Obj *objPtr);
|
||||
MODULE_SCOPE const char * TclObjTypeName(const Tcl_ObjType *typePtr);
|
||||
MODULE_SCOPE int TclObjTypeVersion (const Tcl_ObjType *typePtr);
|
||||
MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
|
||||
Tcl_Obj *part2Ptr, const char *operation,
|
||||
const char *reason, int index);
|
||||
@@ -3280,6 +3523,7 @@ MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, const char *string,
|
||||
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,
|
||||
@@ -3311,7 +3555,7 @@ MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp,
|
||||
const char **errorMsgPtr);
|
||||
MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr,
|
||||
Tcl_ThreadCreateProc *proc, void *clientData,
|
||||
size_t stackSize, int flags);
|
||||
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);
|
||||
@@ -3340,6 +3584,7 @@ MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
|
||||
MODULE_SCOPE Tcl_Obj * TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
|
||||
int linkType);
|
||||
MODULE_SCOPE int TclpObjChdir(Tcl_Obj *pathPtr);
|
||||
MODULE_SCOPE void Tcl_ObjTypeVersion(Tcl_Obj *objPtr, int *version);
|
||||
MODULE_SCOPE Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj,
|
||||
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
|
||||
Tcl_Obj *resultingNameObj);
|
||||
@@ -3380,13 +3625,15 @@ 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_Size numBytes);
|
||||
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,
|
||||
int *reqlength);
|
||||
Tcl_Size *reqlength);
|
||||
MODULE_SCOPE int TclStringIndexInterface(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
Tcl_Obj *indexPtr, Tcl_Obj **charPtr);
|
||||
MODULE_SCOPE int TclStringMatch(const char *str, Tcl_Size strLen,
|
||||
const char *pattern, int ptnLen, int flags);
|
||||
MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj,
|
||||
@@ -3412,18 +3659,10 @@ MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command);
|
||||
MODULE_SCOPE void TclRegisterCommandTypeName(
|
||||
Tcl_ObjCmdProc *implementationProc,
|
||||
const char *nameStr);
|
||||
MODULE_SCOPE void TclUndoRefCount(Tcl_Obj *objPtr);
|
||||
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 *);
|
||||
MODULE_SCOPE const Tcl_UniChar *TclUCS4Prev(const Tcl_UniChar *, const Tcl_UniChar *);
|
||||
#endif
|
||||
MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(void *clientData);
|
||||
MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr);
|
||||
MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
|
||||
@@ -4033,7 +4272,7 @@ MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp,
|
||||
* candidates for public interface.
|
||||
*/
|
||||
|
||||
MODULE_SCOPE Tcl_Obj * TclStringCat(Tcl_Interp *interp, int objc,
|
||||
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);
|
||||
@@ -4173,7 +4412,12 @@ MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
MODULE_SCOPE Tcl_Size TclIndexDecode(int encoded, Tcl_Size endValue);
|
||||
MODULE_SCOPE int TclIndexInvalidError(Tcl_Interp *interp,
|
||||
const char *idxType, Tcl_Size idx);
|
||||
#endif /* TCL_MAJOR_VERSION > 8 */
|
||||
|
||||
/*
|
||||
* Error message utility functions
|
||||
*/
|
||||
MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, Tcl_Size count);
|
||||
|
||||
|
||||
/* Constants used in index value encoding routines. */
|
||||
#define TCL_INDEX_END ((Tcl_Size)-2)
|
||||
@@ -4456,15 +4700,12 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
|
||||
# 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
|
||||
* 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
|
||||
@@ -4477,17 +4718,22 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
|
||||
* 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:
|
||||
* 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) { \
|
||||
(objPtr)->bytes = &tclEmptyString; \
|
||||
(objPtr)->length = 0; \
|
||||
TclInitEmptyStringRep(objPtr); \
|
||||
} else { \
|
||||
(objPtr)->bytes = (char *)Tcl_Alloc((len) + 1U); \
|
||||
memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \
|
||||
@@ -4495,6 +4741,16 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
|
||||
(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
|
||||
@@ -4674,17 +4930,10 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
|
||||
*----------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#if TCL_UTF_MAX > 3
|
||||
#define TclUtfToUniChar(str, chPtr) \
|
||||
(((UCHAR(*(str))) < 0x80) ? \
|
||||
((*(chPtr) = UCHAR(*(str))), 1) \
|
||||
: Tcl_UtfToUniChar(str, chPtr))
|
||||
#else
|
||||
#define TclUtfToUniChar(str, chPtr) \
|
||||
(((UCHAR(*(str))) < 0x80) ? \
|
||||
((*(chPtr) = UCHAR(*(str))), 1) \
|
||||
: Tcl_UtfToChar16(str, chPtr))
|
||||
#endif
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
@@ -4747,7 +4996,7 @@ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
|
||||
*----------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
|
||||
#if defined(WORDS_BIGENDIAN)
|
||||
# define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar))
|
||||
#endif /* WORDS_BIGENDIAN */
|
||||
|
||||
@@ -4793,8 +5042,8 @@ 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 TcltestObjectInterfaceInit;
|
||||
MODULE_SCOPE Tcl_LibraryInitProc TcltestObjectInterfaceListIntegerInit;
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
@@ -4825,7 +5074,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
|
||||
Tcl_ObjInternalRep ir; \
|
||||
ir.wideValue = (Tcl_WideInt) i; \
|
||||
TclInvalidateStringRep(objPtr); \
|
||||
Tcl_StoreInternalRep(objPtr, &tclIntType.objType, &ir); \
|
||||
Tcl_StoreInternalRep(objPtr, tclIntType, &ir); \
|
||||
} while (0)
|
||||
|
||||
#define TclSetDoubleObj(objPtr, d) \
|
||||
@@ -4833,7 +5082,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
|
||||
Tcl_ObjInternalRep ir; \
|
||||
ir.doubleValue = (double) d; \
|
||||
TclInvalidateStringRep(objPtr); \
|
||||
Tcl_StoreInternalRep(objPtr, &tclDoubleType.objType, &ir); \
|
||||
Tcl_StoreInternalRep(objPtr, tclDoubleType, &ir); \
|
||||
} while (0)
|
||||
|
||||
/*
|
||||
@@ -4858,7 +5107,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
|
||||
(objPtr)->refCount = 0; \
|
||||
(objPtr)->bytes = NULL; \
|
||||
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
|
||||
(objPtr)->typePtr = &tclIntType.objType; \
|
||||
(objPtr)->typePtr = tclIntType; \
|
||||
TCL_DTRACE_OBJ_CREATE(objPtr); \
|
||||
} while (0)
|
||||
|
||||
@@ -4877,7 +5126,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
|
||||
TclSetBignumInternalRep((objPtr), &bignumValue_); \
|
||||
} else { \
|
||||
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_); \
|
||||
(objPtr)->typePtr = &tclIntType.objType; \
|
||||
(objPtr)->typePtr = tclIntType; \
|
||||
} \
|
||||
TCL_DTRACE_OBJ_CREATE(objPtr); \
|
||||
} while (0)
|
||||
@@ -4892,7 +5141,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
|
||||
(objPtr)->refCount = 0; \
|
||||
(objPtr)->bytes = NULL; \
|
||||
(objPtr)->internalRep.doubleValue = (double)(d); \
|
||||
(objPtr)->typePtr = &tclDoubleType.objType; \
|
||||
(objPtr)->typePtr = tclDoubleType; \
|
||||
TCL_DTRACE_OBJ_CREATE(objPtr); \
|
||||
} while (0)
|
||||
|
||||
@@ -4926,14 +5175,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
|
||||
} while (0)
|
||||
|
||||
#define TclNewIndexObj(objPtr, w) \
|
||||
do { \
|
||||
Tcl_WideUInt _uw = (Tcl_WideUInt)(w); \
|
||||
if (_uw >= TCL_INDEX_NONE) { \
|
||||
TclNewIntObj(objPtr, -1); \
|
||||
} else { \
|
||||
TclNewUIntObj(objPtr, _uw); \
|
||||
} \
|
||||
} while (0)
|
||||
TclNewIntObj(objPtr, w)
|
||||
|
||||
#define TclNewDoubleObj(objPtr, d) \
|
||||
(objPtr) = Tcl_NewDoubleObj(d)
|
||||
|
||||
+3
-11
@@ -451,7 +451,8 @@ EXTERN Tcl_Obj * TclGetObjNameOfExecutable(void);
|
||||
EXTERN void TclSetObjNameOfExecutable(Tcl_Obj *name,
|
||||
Tcl_Encoding encoding);
|
||||
/* 215 */
|
||||
EXTERN void * TclStackAlloc(Tcl_Interp *interp, Tcl_Size numBytes);
|
||||
EXTERN void * TclStackAlloc(Tcl_Interp *interp,
|
||||
TCL_HASH_TYPE numBytes);
|
||||
/* 216 */
|
||||
EXTERN void TclStackFree(Tcl_Interp *interp, void *freePtr);
|
||||
/* 217 */
|
||||
@@ -803,7 +804,7 @@ typedef struct TclIntStubs {
|
||||
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 * (*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 */
|
||||
@@ -1280,15 +1281,6 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
(tclIntStubsPtr->tclStaticLibrary)
|
||||
#endif /* defined(USE_TCL_STUBS) */
|
||||
|
||||
#if (TCL_MAJOR_VERSION < 9) && defined(USE_TCL_STUBS)
|
||||
#undef TclpGetClicks
|
||||
#define TclpGetClicks() \
|
||||
((unsigned long)tclIntStubsPtr->tclpGetClicks())
|
||||
#undef TclpGetSeconds
|
||||
#define TclpGetSeconds() \
|
||||
((unsigned long)tclIntStubsPtr->tclpGetSeconds())
|
||||
#endif
|
||||
|
||||
#undef TclObjInterpProc
|
||||
#define TclObjInterpProc TclGetObjInterpProc()
|
||||
#define TclObjInterpProc2 TclGetObjInterpProc2()
|
||||
|
||||
@@ -30,535 +30,6 @@
|
||||
* in the generic/tclInt.decls script.
|
||||
*/
|
||||
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Exported function declarations:
|
||||
*/
|
||||
|
||||
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
/* 0 */
|
||||
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
|
||||
Tcl_Channel chan);
|
||||
/* 1 */
|
||||
EXTERN int TclpCloseFile(TclFile file);
|
||||
/* 2 */
|
||||
EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
|
||||
TclFile writeFile, TclFile errorFile,
|
||||
int numPids, Tcl_Pid *pidPtr);
|
||||
/* 3 */
|
||||
EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
|
||||
/* 4 */
|
||||
EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
|
||||
const char **argv, TclFile inputFile,
|
||||
TclFile outputFile, TclFile errorFile,
|
||||
Tcl_Pid *pidPtr);
|
||||
/* 5 */
|
||||
EXTERN int TclUnixWaitForFile_(int fd, int mask, int timeout);
|
||||
/* 6 */
|
||||
EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
|
||||
/* 7 */
|
||||
EXTERN TclFile TclpOpenFile(const char *fname, int mode);
|
||||
/* 8 */
|
||||
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
|
||||
/* 9 */
|
||||
EXTERN TclFile TclpCreateTempFile(const char *contents);
|
||||
/* 10 */
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
|
||||
/* 11 */
|
||||
EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
|
||||
/* 12 */
|
||||
EXTERN struct tm * TclpGmtime_unix(const time_t *clock);
|
||||
/* 13 */
|
||||
EXTERN char * TclpInetNtoa(struct in_addr addr);
|
||||
/* 14 */
|
||||
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
|
||||
const Tcl_StatBuf *statBufPtr,
|
||||
int dontCopyAtts);
|
||||
/* 15 */
|
||||
EXTERN int TclMacOSXGetFileAttribute(Tcl_Interp *interp,
|
||||
int objIndex, Tcl_Obj *fileName,
|
||||
Tcl_Obj **attributePtrPtr);
|
||||
/* 16 */
|
||||
EXTERN int TclMacOSXSetFileAttribute(Tcl_Interp *interp,
|
||||
int objIndex, Tcl_Obj *fileName,
|
||||
Tcl_Obj *attributePtr);
|
||||
/* 17 */
|
||||
EXTERN int TclMacOSXCopyFileAttributes(const char *src,
|
||||
const char *dst,
|
||||
const Tcl_StatBuf *statBufPtr);
|
||||
/* 18 */
|
||||
EXTERN int TclMacOSXMatchType(Tcl_Interp *interp,
|
||||
const char *pathName, const char *fileName,
|
||||
Tcl_StatBuf *statBufPtr,
|
||||
Tcl_GlobTypeData *types);
|
||||
/* 19 */
|
||||
EXTERN void TclMacOSXNotifierAddRunLoopMode(
|
||||
const void *runLoopMode);
|
||||
/* Slot 20 is reserved */
|
||||
/* Slot 21 is reserved */
|
||||
/* 22 */
|
||||
EXTERN TclFile TclpCreateTempFile_(const char *contents);
|
||||
/* Slot 23 is reserved */
|
||||
/* Slot 24 is reserved */
|
||||
/* Slot 25 is reserved */
|
||||
/* Slot 26 is reserved */
|
||||
/* Slot 27 is reserved */
|
||||
/* Slot 28 is reserved */
|
||||
/* 29 */
|
||||
EXTERN int TclWinCPUID(int index, int *regs);
|
||||
/* 30 */
|
||||
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
|
||||
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
|
||||
Tcl_Obj *resultingNameObj);
|
||||
#endif /* UNIX */
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
/* 0 */
|
||||
EXTERN void TclWinConvertError(DWORD errCode);
|
||||
/* 1 */
|
||||
EXTERN void TclWinConvertWSAError(DWORD errCode);
|
||||
/* 2 */
|
||||
EXTERN struct servent * TclWinGetServByName(const char *nm,
|
||||
const char *proto);
|
||||
/* 3 */
|
||||
EXTERN int TclWinGetSockOpt(SOCKET s, int level, int optname,
|
||||
char *optval, int *optlen);
|
||||
/* 4 */
|
||||
EXTERN HINSTANCE TclWinGetTclInstance(void);
|
||||
/* 5 */
|
||||
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
|
||||
/* 6 */
|
||||
EXTERN unsigned short TclWinNToHS(unsigned short ns);
|
||||
/* 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,
|
||||
TclFile writeFile, TclFile errorFile,
|
||||
int numPids, Tcl_Pid *pidPtr);
|
||||
/* 14 */
|
||||
EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
|
||||
/* 15 */
|
||||
EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
|
||||
const char **argv, TclFile inputFile,
|
||||
TclFile outputFile, TclFile errorFile,
|
||||
Tcl_Pid *pidPtr);
|
||||
/* 16 */
|
||||
EXTERN int TclpIsAtty(int fd);
|
||||
/* 17 */
|
||||
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
|
||||
const Tcl_StatBuf *statBufPtr,
|
||||
int dontCopyAtts);
|
||||
/* 18 */
|
||||
EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
|
||||
/* 19 */
|
||||
EXTERN TclFile TclpOpenFile(const char *fname, int mode);
|
||||
/* 20 */
|
||||
EXTERN void TclWinAddProcess(HANDLE hProcess, DWORD id);
|
||||
/* 21 */
|
||||
EXTERN char * TclpInetNtoa(struct in_addr addr);
|
||||
/* 22 */
|
||||
EXTERN TclFile TclpCreateTempFile(const char *contents);
|
||||
/* Slot 23 is reserved */
|
||||
/* 24 */
|
||||
EXTERN char * TclWinNoBackslash(char *path);
|
||||
/* Slot 25 is reserved */
|
||||
/* 26 */
|
||||
EXTERN void TclWinSetInterfaces(int wide);
|
||||
/* 27 */
|
||||
EXTERN void TclWinFlushDirtyChannels(void);
|
||||
/* 28 */
|
||||
EXTERN void TclWinResetInterfaces(void);
|
||||
/* 29 */
|
||||
EXTERN int TclWinCPUID(int index, int *regs);
|
||||
/* 30 */
|
||||
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
|
||||
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
|
||||
Tcl_Obj *resultingNameObj);
|
||||
#endif /* WIN */
|
||||
#ifdef MAC_OSX_TCL /* MACOSX */
|
||||
/* 0 */
|
||||
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
|
||||
Tcl_Channel chan);
|
||||
/* 1 */
|
||||
EXTERN int TclpCloseFile(TclFile file);
|
||||
/* 2 */
|
||||
EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
|
||||
TclFile writeFile, TclFile errorFile,
|
||||
int numPids, Tcl_Pid *pidPtr);
|
||||
/* 3 */
|
||||
EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
|
||||
/* 4 */
|
||||
EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
|
||||
const char **argv, TclFile inputFile,
|
||||
TclFile outputFile, TclFile errorFile,
|
||||
Tcl_Pid *pidPtr);
|
||||
/* 5 */
|
||||
EXTERN int TclUnixWaitForFile_(int fd, int mask, int timeout);
|
||||
/* 6 */
|
||||
EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
|
||||
/* 7 */
|
||||
EXTERN TclFile TclpOpenFile(const char *fname, int mode);
|
||||
/* 8 */
|
||||
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
|
||||
/* 9 */
|
||||
EXTERN TclFile TclpCreateTempFile(const char *contents);
|
||||
/* 10 */
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
|
||||
/* 11 */
|
||||
EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
|
||||
/* 12 */
|
||||
EXTERN struct tm * TclpGmtime_unix(const time_t *clock);
|
||||
/* 13 */
|
||||
EXTERN char * TclpInetNtoa(struct in_addr addr);
|
||||
/* 14 */
|
||||
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
|
||||
const Tcl_StatBuf *statBufPtr,
|
||||
int dontCopyAtts);
|
||||
/* 15 */
|
||||
EXTERN int TclMacOSXGetFileAttribute(Tcl_Interp *interp,
|
||||
int objIndex, Tcl_Obj *fileName,
|
||||
Tcl_Obj **attributePtrPtr);
|
||||
/* 16 */
|
||||
EXTERN int TclMacOSXSetFileAttribute(Tcl_Interp *interp,
|
||||
int objIndex, Tcl_Obj *fileName,
|
||||
Tcl_Obj *attributePtr);
|
||||
/* 17 */
|
||||
EXTERN int TclMacOSXCopyFileAttributes(const char *src,
|
||||
const char *dst,
|
||||
const Tcl_StatBuf *statBufPtr);
|
||||
/* 18 */
|
||||
EXTERN int TclMacOSXMatchType(Tcl_Interp *interp,
|
||||
const char *pathName, const char *fileName,
|
||||
Tcl_StatBuf *statBufPtr,
|
||||
Tcl_GlobTypeData *types);
|
||||
/* 19 */
|
||||
EXTERN void TclMacOSXNotifierAddRunLoopMode(
|
||||
const void *runLoopMode);
|
||||
/* Slot 20 is reserved */
|
||||
/* Slot 21 is reserved */
|
||||
/* 22 */
|
||||
EXTERN TclFile TclpCreateTempFile_(const char *contents);
|
||||
/* Slot 23 is reserved */
|
||||
/* Slot 24 is reserved */
|
||||
/* Slot 25 is reserved */
|
||||
/* Slot 26 is reserved */
|
||||
/* Slot 27 is reserved */
|
||||
/* Slot 28 is reserved */
|
||||
/* 29 */
|
||||
EXTERN int TclWinCPUID(int index, int *regs);
|
||||
/* 30 */
|
||||
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
|
||||
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
|
||||
Tcl_Obj *resultingNameObj);
|
||||
#endif /* MACOSX */
|
||||
|
||||
typedef struct TclIntPlatStubs {
|
||||
int magic;
|
||||
void *hooks;
|
||||
|
||||
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
|
||||
int (*tclpCloseFile) (TclFile file); /* 1 */
|
||||
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
|
||||
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
|
||||
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
|
||||
int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */
|
||||
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
|
||||
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
|
||||
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
|
||||
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
|
||||
struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
|
||||
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
|
||||
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
|
||||
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
|
||||
int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
|
||||
int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
|
||||
int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
|
||||
int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
|
||||
void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
|
||||
void (*reserved20)(void);
|
||||
void (*reserved21)(void);
|
||||
TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */
|
||||
void (*reserved23)(void);
|
||||
void (*reserved24)(void);
|
||||
void (*reserved25)(void);
|
||||
void (*reserved26)(void);
|
||||
void (*reserved27)(void);
|
||||
void (*reserved28)(void);
|
||||
int (*tclWinCPUID) (int index, int *regs); /* 29 */
|
||||
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
|
||||
#endif /* UNIX */
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
void (*tclWinConvertError) (DWORD errCode); /* 0 */
|
||||
void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
|
||||
struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
|
||||
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 */
|
||||
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
|
||||
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
|
||||
void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
|
||||
char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */
|
||||
TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
|
||||
void (*reserved23)(void);
|
||||
char * (*tclWinNoBackslash) (char *path); /* 24 */
|
||||
void (*reserved25)(void);
|
||||
void (*tclWinSetInterfaces) (int wide); /* 26 */
|
||||
void (*tclWinFlushDirtyChannels) (void); /* 27 */
|
||||
void (*tclWinResetInterfaces) (void); /* 28 */
|
||||
int (*tclWinCPUID) (int index, int *regs); /* 29 */
|
||||
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
|
||||
#endif /* WIN */
|
||||
#ifdef MAC_OSX_TCL /* MACOSX */
|
||||
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
|
||||
int (*tclpCloseFile) (TclFile file); /* 1 */
|
||||
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
|
||||
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
|
||||
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
|
||||
int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */
|
||||
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
|
||||
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
|
||||
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
|
||||
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
|
||||
struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
|
||||
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
|
||||
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
|
||||
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
|
||||
int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
|
||||
int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
|
||||
int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
|
||||
int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
|
||||
void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
|
||||
void (*reserved20)(void);
|
||||
void (*reserved21)(void);
|
||||
TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */
|
||||
void (*reserved23)(void);
|
||||
void (*reserved24)(void);
|
||||
void (*reserved25)(void);
|
||||
void (*reserved26)(void);
|
||||
void (*reserved27)(void);
|
||||
void (*reserved28)(void);
|
||||
int (*tclWinCPUID) (int index, int *regs); /* 29 */
|
||||
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
|
||||
#endif /* MACOSX */
|
||||
} TclIntPlatStubs;
|
||||
|
||||
extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#if defined(USE_TCL_STUBS)
|
||||
|
||||
/*
|
||||
* Inline function declarations:
|
||||
*/
|
||||
|
||||
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#define TclGetAndDetachPids \
|
||||
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
|
||||
#define TclpCloseFile \
|
||||
(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
|
||||
#define TclpCreateCommandChannel \
|
||||
(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
|
||||
#define TclpCreatePipe \
|
||||
(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
|
||||
#define TclpCreateProcess \
|
||||
(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
|
||||
#define TclUnixWaitForFile_ \
|
||||
(tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */
|
||||
#define TclpMakeFile \
|
||||
(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
|
||||
#define TclpOpenFile \
|
||||
(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
|
||||
#define TclUnixWaitForFile \
|
||||
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
|
||||
#define TclpCreateTempFile \
|
||||
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
|
||||
#define TclpReaddir \
|
||||
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
|
||||
#define TclpLocaltime_unix \
|
||||
(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
|
||||
#define TclpGmtime_unix \
|
||||
(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
|
||||
#define TclpInetNtoa \
|
||||
(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
|
||||
#define TclUnixCopyFile \
|
||||
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
|
||||
#define TclMacOSXGetFileAttribute \
|
||||
(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
|
||||
#define TclMacOSXSetFileAttribute \
|
||||
(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
|
||||
#define TclMacOSXCopyFileAttributes \
|
||||
(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
|
||||
#define TclMacOSXMatchType \
|
||||
(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
|
||||
#define TclMacOSXNotifierAddRunLoopMode \
|
||||
(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
|
||||
/* Slot 20 is reserved */
|
||||
/* Slot 21 is reserved */
|
||||
#define TclpCreateTempFile_ \
|
||||
(tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */
|
||||
/* Slot 23 is reserved */
|
||||
/* Slot 24 is reserved */
|
||||
/* Slot 25 is reserved */
|
||||
/* Slot 26 is reserved */
|
||||
/* Slot 27 is reserved */
|
||||
/* Slot 28 is reserved */
|
||||
#define TclWinCPUID \
|
||||
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
|
||||
#define TclUnixOpenTemporaryFile \
|
||||
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
|
||||
#endif /* UNIX */
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
#define TclWinConvertError \
|
||||
(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
|
||||
#define TclWinConvertWSAError \
|
||||
(tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
|
||||
#define TclWinGetServByName \
|
||||
(tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */
|
||||
#define TclWinGetSockOpt \
|
||||
(tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */
|
||||
#define TclWinGetTclInstance \
|
||||
(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
|
||||
#define TclUnixWaitForFile \
|
||||
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
|
||||
#define TclWinNToHS \
|
||||
(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 \
|
||||
(tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */
|
||||
#define TclpCreateProcess \
|
||||
(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
|
||||
#define TclpIsAtty \
|
||||
(tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
|
||||
#define TclUnixCopyFile \
|
||||
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
|
||||
#define TclpMakeFile \
|
||||
(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
|
||||
#define TclpOpenFile \
|
||||
(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
|
||||
#define TclWinAddProcess \
|
||||
(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
|
||||
#define TclpInetNtoa \
|
||||
(tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */
|
||||
#define TclpCreateTempFile \
|
||||
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
|
||||
/* Slot 23 is reserved */
|
||||
#define TclWinNoBackslash \
|
||||
(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
|
||||
/* Slot 25 is reserved */
|
||||
#define TclWinSetInterfaces \
|
||||
(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
|
||||
#define TclWinFlushDirtyChannels \
|
||||
(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
|
||||
#define TclWinResetInterfaces \
|
||||
(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
|
||||
#define TclWinCPUID \
|
||||
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
|
||||
#define TclUnixOpenTemporaryFile \
|
||||
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
|
||||
#endif /* WIN */
|
||||
#ifdef MAC_OSX_TCL /* MACOSX */
|
||||
#define TclGetAndDetachPids \
|
||||
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
|
||||
#define TclpCloseFile \
|
||||
(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
|
||||
#define TclpCreateCommandChannel \
|
||||
(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
|
||||
#define TclpCreatePipe \
|
||||
(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
|
||||
#define TclpCreateProcess \
|
||||
(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
|
||||
#define TclUnixWaitForFile_ \
|
||||
(tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */
|
||||
#define TclpMakeFile \
|
||||
(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
|
||||
#define TclpOpenFile \
|
||||
(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
|
||||
#define TclUnixWaitForFile \
|
||||
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
|
||||
#define TclpCreateTempFile \
|
||||
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
|
||||
#define TclpReaddir \
|
||||
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
|
||||
#define TclpLocaltime_unix \
|
||||
(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
|
||||
#define TclpGmtime_unix \
|
||||
(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
|
||||
#define TclpInetNtoa \
|
||||
(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
|
||||
#define TclUnixCopyFile \
|
||||
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
|
||||
#define TclMacOSXGetFileAttribute \
|
||||
(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
|
||||
#define TclMacOSXSetFileAttribute \
|
||||
(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
|
||||
#define TclMacOSXCopyFileAttributes \
|
||||
(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
|
||||
#define TclMacOSXMatchType \
|
||||
(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
|
||||
#define TclMacOSXNotifierAddRunLoopMode \
|
||||
(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
|
||||
/* Slot 20 is reserved */
|
||||
/* Slot 21 is reserved */
|
||||
#define TclpCreateTempFile_ \
|
||||
(tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */
|
||||
/* Slot 23 is reserved */
|
||||
/* Slot 24 is reserved */
|
||||
/* Slot 25 is reserved */
|
||||
/* Slot 26 is reserved */
|
||||
/* Slot 27 is reserved */
|
||||
/* Slot 28 is reserved */
|
||||
#define TclWinCPUID \
|
||||
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
|
||||
#define TclUnixOpenTemporaryFile \
|
||||
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
|
||||
#endif /* MACOSX */
|
||||
|
||||
#endif /* defined(USE_TCL_STUBS) */
|
||||
|
||||
#else /* TCL_MAJOR_VERSION > 8 */
|
||||
/* !BEGIN!: Do not edit below this line. */
|
||||
|
||||
#ifdef __cplusplus
|
||||
@@ -731,7 +202,6 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
#endif /* defined(USE_TCL_STUBS) */
|
||||
|
||||
/* !END!: Do not edit above this line. */
|
||||
#endif /* TCL_MAJOR_VERSION */
|
||||
|
||||
#undef TCL_STORAGE_CLASS
|
||||
#define TCL_STORAGE_CLASS DLLIMPORT
|
||||
@@ -739,10 +209,6 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
#undef TclpGmtime_unix
|
||||
#undef TclWinConvertWSAError
|
||||
#define TclWinConvertWSAError TclWinConvertError
|
||||
#if !defined(TCL_USE_STUBS) && !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
# undef TclWinConvertError
|
||||
# define TclWinConvertError Tcl_WinConvertError
|
||||
#endif
|
||||
|
||||
#undef TclpInetNtoa
|
||||
#define TclpInetNtoa inet_ntoa
|
||||
@@ -782,15 +248,6 @@ MODULE_SCOPE int TclMacOSXMatchType(Tcl_Interp *interp,
|
||||
# undef TclWinGetPlatformId
|
||||
# undef TclWinResetInterfaces
|
||||
# undef TclWinSetInterfaces
|
||||
# if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
# define TclWinNToHS ntohs
|
||||
# define TclWinGetServByName getservbyname
|
||||
# define TclWinGetSockOpt getsockopt
|
||||
# define TclWinSetSockOpt setsockopt
|
||||
# define TclWinGetPlatformId() (2) /* VER_PLATFORM_WIN32_NT */
|
||||
# define TclWinResetInterfaces() /* nop */
|
||||
# define TclWinSetInterfaces(dummy) /* nop */
|
||||
# endif /* TCL_NO_DEPRECATED */
|
||||
#else
|
||||
# undef TclpGetPid
|
||||
# define TclpGetPid(pid) ((size_t)(pid))
|
||||
|
||||
@@ -624,9 +624,7 @@ NRInterpCmd(
|
||||
"hidden", "issafe", "invokehidden",
|
||||
"limit", "marktrusted", "recursionlimit",
|
||||
"share",
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
"slaves",
|
||||
#endif
|
||||
"target", "transfer", NULL
|
||||
};
|
||||
static const char *const optionsNoSlaves[] = {
|
||||
@@ -644,9 +642,7 @@ NRInterpCmd(
|
||||
OPT_EVAL, OPT_EXISTS, OPT_EXPOSE, OPT_HIDE,
|
||||
OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHID,
|
||||
OPT_LIMIT, OPT_MARKTRUSTED, OPT_RECLIMIT, OPT_SHARE,
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
OPT_SLAVES,
|
||||
#endif
|
||||
OPT_TARGET, OPT_TRANSFER
|
||||
} index;
|
||||
|
||||
@@ -1033,9 +1029,7 @@ NRInterpCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
return ChildRecursionLimit(interp, childInterp, objc - 3, objv + 3);
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
case OPT_SLAVES:
|
||||
#endif
|
||||
case OPT_CHILDREN: {
|
||||
InterpInfo *iiPtr;
|
||||
Tcl_Obj *resultPtr;
|
||||
|
||||
+3
-19
@@ -179,14 +179,6 @@ Tcl_LinkVar(
|
||||
Tcl_IncrRefCount(linkPtr->varName);
|
||||
linkPtr->addr = addr;
|
||||
linkPtr->type = type & ~TCL_LINK_READ_ONLY;
|
||||
#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
|
||||
|| defined(_WIN32) || defined(__CYGWIN__))
|
||||
if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) {
|
||||
linkPtr->type = TCL_LINK_LONG;
|
||||
} else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) {
|
||||
linkPtr->type = TCL_LINK_ULONG;
|
||||
}
|
||||
#endif
|
||||
if (type & TCL_LINK_READ_ONLY) {
|
||||
linkPtr->flags = LINK_READ_ONLY;
|
||||
} else {
|
||||
@@ -262,14 +254,6 @@ Tcl_LinkArray(
|
||||
|
||||
linkPtr = (Link *)Tcl_Alloc(sizeof(Link));
|
||||
linkPtr->type = type & ~TCL_LINK_READ_ONLY;
|
||||
#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
|
||||
|| defined(_WIN32) || defined(__CYGWIN__))
|
||||
if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) {
|
||||
linkPtr->type = TCL_LINK_LONG;
|
||||
} else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) {
|
||||
linkPtr->type = TCL_LINK_ULONG;
|
||||
}
|
||||
#endif
|
||||
linkPtr->numElems = size;
|
||||
if (type & TCL_LINK_READ_ONLY) {
|
||||
linkPtr->flags = LINK_READ_ONLY;
|
||||
@@ -547,7 +531,7 @@ GetDouble(
|
||||
return 0;
|
||||
} else {
|
||||
#ifdef ACCEPT_NAN
|
||||
Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &tclDoubleType.objType);
|
||||
Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, tclDoubleType);
|
||||
|
||||
if (irPtr != NULL) {
|
||||
*dblPtr = irPtr->doubleValue;
|
||||
@@ -592,7 +576,7 @@ SetInvalidRealFromAny(
|
||||
{
|
||||
const char *str;
|
||||
const char *endPtr;
|
||||
size_t length;
|
||||
Tcl_Size length;
|
||||
|
||||
str = Tcl_GetStringFromObj(objPtr, &length);
|
||||
if ((length == 1) && (str[0] == '.')) {
|
||||
@@ -638,7 +622,7 @@ GetInvalidIntFromObj(
|
||||
Tcl_Obj *objPtr,
|
||||
int *intPtr)
|
||||
{
|
||||
size_t length;
|
||||
Tcl_Size length;
|
||||
const char *str = Tcl_GetStringFromObj(objPtr, &length);
|
||||
|
||||
if ((length == 0) || ((length == 2) && (str[0] == '0')
|
||||
|
||||
+538
-343
File diff suppressed because it is too large
Load Diff
@@ -560,7 +560,8 @@ TclHideLiteral(
|
||||
{
|
||||
LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
|
||||
LiteralTable *localTablePtr = &envPtr->localLitTable;
|
||||
size_t localHash, length;
|
||||
size_t localHash;
|
||||
Tcl_Size length;
|
||||
const char *bytes;
|
||||
Tcl_Obj *newObjPtr;
|
||||
|
||||
@@ -645,7 +646,7 @@ TclAddLiteralObj(
|
||||
if (litPtrPtr) {
|
||||
*litPtrPtr = lPtr;
|
||||
}
|
||||
|
||||
|
||||
return objIndex;
|
||||
}
|
||||
|
||||
@@ -837,7 +838,8 @@ TclReleaseLiteral(
|
||||
LiteralTable *globalTablePtr;
|
||||
LiteralEntry *entryPtr, *prevPtr;
|
||||
const char *bytes;
|
||||
size_t length, index;
|
||||
size_t index;
|
||||
Tcl_Size length;
|
||||
|
||||
if (iPtr == NULL) {
|
||||
goto done;
|
||||
@@ -980,7 +982,8 @@ RebuildLiteralTable(
|
||||
LiteralEntry *entryPtr;
|
||||
LiteralEntry **bucketPtr;
|
||||
const char *bytes;
|
||||
size_t oldSize, count, index, length;
|
||||
size_t oldSize, count, index;
|
||||
Tcl_Size length;
|
||||
|
||||
oldSize = tablePtr->numBuckets;
|
||||
oldBuckets = tablePtr->buckets;
|
||||
|
||||
+1
-1
@@ -3145,7 +3145,7 @@ NamespaceCodeCmd(
|
||||
Namespace *currNsPtr;
|
||||
Tcl_Obj *listPtr, *objPtr;
|
||||
const char *arg;
|
||||
size_t length;
|
||||
Tcl_Size length;
|
||||
|
||||
if (objc != 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "arg");
|
||||
|
||||
+50
-10
@@ -3,7 +3,7 @@
|
||||
*
|
||||
* This file contains the object-system core (NB: not Tcl_Obj, but ::oo)
|
||||
*
|
||||
* Copyright © 2005-2012 Donal K. Fellows
|
||||
* Copyright © 2005-2019 Donal K. Fellows
|
||||
* Copyright © 2017 Nathan Coulter
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
@@ -138,9 +138,6 @@ static const Tcl_MethodType classConstructor = {
|
||||
*/
|
||||
|
||||
static const char initScript[] =
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
"package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};"
|
||||
#endif
|
||||
"package ifneeded tcl::oo " TCLOO_PATCHLEVEL " {# Already present, OK?};"
|
||||
"namespace eval ::oo { variable version " TCLOO_VERSION " };"
|
||||
"namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
|
||||
@@ -260,10 +257,6 @@ TclOOInit(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
|
||||
&tclOOStubs);
|
||||
#endif
|
||||
return Tcl_PkgProvideEx(interp, "tcl::oo", TCLOO_PATCHLEVEL,
|
||||
&tclOOStubs);
|
||||
}
|
||||
@@ -327,6 +320,7 @@ InitFoundation(
|
||||
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");
|
||||
@@ -964,7 +958,7 @@ TclOOReleaseClassContents(
|
||||
Class *clsPtr = oPtr->classPtr, *tmpClsPtr;
|
||||
Method *mPtr;
|
||||
Foundation *fPtr = oPtr->fPtr;
|
||||
Tcl_Obj *variableObj;
|
||||
Tcl_Obj *variableObj, *propertyObj;
|
||||
PrivateVariableMapping *privateVariable;
|
||||
|
||||
/*
|
||||
@@ -1017,6 +1011,29 @@ TclOOReleaseClassContents(
|
||||
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.
|
||||
*/
|
||||
@@ -1118,7 +1135,7 @@ ObjectNamespaceDeleted(
|
||||
FOREACH_HASH_DECLS;
|
||||
Class *mixinPtr;
|
||||
Method *mPtr;
|
||||
Tcl_Obj *filterObj, *variableObj;
|
||||
Tcl_Obj *filterObj, *variableObj, *propertyObj;
|
||||
PrivateVariableMapping *privateVariable;
|
||||
Tcl_Interp *interp = oPtr->fPtr->interp;
|
||||
Tcl_Size i;
|
||||
@@ -1271,6 +1288,29 @@ ObjectNamespaceDeleted(
|
||||
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
|
||||
|
||||
+1
-1
@@ -63,7 +63,7 @@ typedef struct Tcl_ObjectContext_ *Tcl_ObjectContext;
|
||||
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, ptrdiff_t objc, Tcl_Obj *const *objv);
|
||||
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);
|
||||
|
||||
@@ -185,7 +185,7 @@ TclOO_Class_Create(
|
||||
{
|
||||
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
|
||||
const char *objName;
|
||||
size_t len;
|
||||
Tcl_Size len;
|
||||
|
||||
/*
|
||||
* Sanity check; should not be possible to invoke this method on a
|
||||
@@ -250,7 +250,7 @@ TclOO_Class_CreateNs(
|
||||
{
|
||||
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
|
||||
const char *objName, *nsName;
|
||||
size_t len;
|
||||
Tcl_Size len;
|
||||
|
||||
/*
|
||||
* Sanity check; should not be possible to invoke this method on a
|
||||
|
||||
+261
-6
@@ -2,9 +2,10 @@
|
||||
* tclOOCall.c --
|
||||
*
|
||||
* This file contains the method call chain management code for the
|
||||
* object-system core.
|
||||
* object-system core. It also contains everything else that does
|
||||
* inheritance hierarchy traversal.
|
||||
*
|
||||
* Copyright © 2005-2012 Donal K. Fellows
|
||||
* 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.
|
||||
@@ -58,6 +59,7 @@ typedef struct {
|
||||
#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))
|
||||
@@ -1907,7 +1909,7 @@ TclOOGetDefineContextNamespace(
|
||||
DefineEntry staticSpace[DEFINE_CHAIN_STATIC_SIZE];
|
||||
DefineEntry *entryPtr;
|
||||
Tcl_Namespace *nsPtr = NULL;
|
||||
int i;
|
||||
int i, flags = (forClass ? DEFINE_FOR_CLASS : 0);
|
||||
|
||||
define.list = staticSpace;
|
||||
define.num = 0;
|
||||
@@ -1918,8 +1920,8 @@ TclOOGetDefineContextNamespace(
|
||||
* class mixins right.
|
||||
*/
|
||||
|
||||
AddSimpleDefineNamespaces(oPtr, &define, forClass | BUILDING_MIXINS);
|
||||
AddSimpleDefineNamespaces(oPtr, &define, forClass);
|
||||
AddSimpleDefineNamespaces(oPtr, &define, flags | BUILDING_MIXINS);
|
||||
AddSimpleDefineNamespaces(oPtr, &define, flags);
|
||||
|
||||
/*
|
||||
* Go through the list until we find a namespace whose name we can
|
||||
@@ -2003,7 +2005,7 @@ AddSimpleClassDefineNamespaces(
|
||||
flags | TRAVERSED_MIXIN);
|
||||
}
|
||||
|
||||
if (flags & ~(TRAVERSED_MIXIN | BUILDING_MIXINS)) {
|
||||
if (flags & DEFINE_FOR_CLASS) {
|
||||
AddDefinitionNamespaceToChain(classPtr, classPtr->clsDefinitionNs,
|
||||
definePtr, flags);
|
||||
} else {
|
||||
@@ -2112,6 +2114,259 @@ AddDefinitionNamespaceToChain(
|
||||
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
|
||||
|
||||
+464
-16
@@ -4,7 +4,7 @@
|
||||
* 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
|
||||
* 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.
|
||||
@@ -60,6 +60,7 @@ struct DeclaredSlot {
|
||||
*/
|
||||
|
||||
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,
|
||||
@@ -102,6 +103,8 @@ static int ClassVarsGet(void *clientData,
|
||||
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);
|
||||
@@ -120,6 +123,8 @@ static int ObjVarsGet(void *clientData,
|
||||
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);
|
||||
@@ -136,6 +141,14 @@ static const struct DeclaredSlot slots[] = {
|
||||
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}}
|
||||
};
|
||||
|
||||
@@ -201,18 +214,58 @@ BumpGlobalEpoch(
|
||||
|
||||
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.
|
||||
* 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;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
@@ -292,7 +345,7 @@ TclOOObjectSetFilters(
|
||||
oPtr->filters.num = numFilters;
|
||||
oPtr->flags &= ~USE_CLASS_CACHE;
|
||||
}
|
||||
oPtr->epoch++; /* Only this object can be affected. */
|
||||
BumpInstanceEpoch(oPtr); /* Only this object can be affected. */
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -415,7 +468,7 @@ TclOOObjectSetMixins(
|
||||
}
|
||||
}
|
||||
}
|
||||
oPtr->epoch++;
|
||||
BumpInstanceEpoch(oPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -482,6 +535,7 @@ TclOOClassSetMixins(
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static inline void
|
||||
InstallStandardVariableMapping(
|
||||
VariableNameList *vnlPtr,
|
||||
@@ -704,7 +758,7 @@ TclOOUnknownDefinition(
|
||||
Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
|
||||
Tcl_HashSearch search;
|
||||
Tcl_HashEntry *hPtr;
|
||||
size_t soughtLen;
|
||||
Tcl_Size soughtLen;
|
||||
const char *soughtStr, *matchedStr = NULL;
|
||||
|
||||
if (objc < 2) {
|
||||
@@ -778,7 +832,7 @@ FindCommand(
|
||||
Tcl_Obj *stringObj,
|
||||
Tcl_Namespace *const namespacePtr)
|
||||
{
|
||||
size_t length;
|
||||
Tcl_Size length;
|
||||
const char *nameStr, *string = Tcl_GetStringFromObj(stringObj, &length);
|
||||
Namespace *const nsPtr = (Namespace *) namespacePtr;
|
||||
FOREACH_HASH_DECLS;
|
||||
@@ -997,16 +1051,16 @@ GenerateErrorInfo(
|
||||
* an object, class or class-as-object that
|
||||
* was being configured. */
|
||||
{
|
||||
size_t length;
|
||||
Tcl_Size 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 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,
|
||||
typeOfSubject, (overflow ? limit : (int)length), objName,
|
||||
(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
|
||||
}
|
||||
|
||||
@@ -1507,7 +1561,7 @@ TclOODefineClassObjCmd(
|
||||
if (oPtr->classPtr != NULL) {
|
||||
BumpGlobalEpoch(interp, oPtr->classPtr);
|
||||
} else {
|
||||
oPtr->epoch++;
|
||||
BumpInstanceEpoch(oPtr);
|
||||
}
|
||||
}
|
||||
return TCL_OK;
|
||||
@@ -1534,7 +1588,7 @@ TclOODefineConstructorObjCmd(
|
||||
Object *oPtr;
|
||||
Class *clsPtr;
|
||||
Tcl_Method method;
|
||||
size_t bodyLength;
|
||||
Tcl_Size bodyLength;
|
||||
|
||||
if (objc != 3) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "arguments body");
|
||||
@@ -1717,7 +1771,7 @@ TclOODefineDeleteMethodObjCmd(
|
||||
}
|
||||
|
||||
if (isInstanceDeleteMethod) {
|
||||
oPtr->epoch++;
|
||||
BumpInstanceEpoch(oPtr);
|
||||
} else {
|
||||
BumpGlobalEpoch(interp, oPtr->classPtr);
|
||||
}
|
||||
@@ -1745,7 +1799,7 @@ TclOODefineDestructorObjCmd(
|
||||
Object *oPtr;
|
||||
Class *clsPtr;
|
||||
Tcl_Method method;
|
||||
size_t bodyLength;
|
||||
Tcl_Size bodyLength;
|
||||
|
||||
if (objc != 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "body");
|
||||
@@ -1877,7 +1931,7 @@ TclOODefineExportObjCmd(
|
||||
|
||||
if (changed) {
|
||||
if (isInstanceExport) {
|
||||
oPtr->epoch++;
|
||||
BumpInstanceEpoch(oPtr);
|
||||
} else {
|
||||
BumpGlobalEpoch(interp, clsPtr);
|
||||
}
|
||||
@@ -2095,7 +2149,7 @@ TclOODefineRenameMethodObjCmd(
|
||||
}
|
||||
|
||||
if (isInstanceRenameMethod) {
|
||||
oPtr->epoch++;
|
||||
BumpInstanceEpoch(oPtr);
|
||||
} else {
|
||||
BumpGlobalEpoch(interp, oPtr->classPtr);
|
||||
}
|
||||
@@ -2189,7 +2243,7 @@ TclOODefineUnexportObjCmd(
|
||||
|
||||
if (changed) {
|
||||
if (isInstanceUnexport) {
|
||||
oPtr->epoch++;
|
||||
BumpInstanceEpoch(oPtr);
|
||||
} else {
|
||||
BumpGlobalEpoch(interp, clsPtr);
|
||||
}
|
||||
@@ -3081,6 +3135,400 @@ ResolveClass(
|
||||
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
|
||||
|
||||
+184
-1
@@ -4,7 +4,7 @@
|
||||
* This file contains the implementation of the ::oo-related [info]
|
||||
* subcommands.
|
||||
*
|
||||
* Copyright © 2006-2011 Donal K. Fellows
|
||||
* 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.
|
||||
@@ -17,6 +17,7 @@
|
||||
#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;
|
||||
@@ -28,6 +29,7 @@ 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;
|
||||
@@ -41,6 +43,7 @@ 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;
|
||||
@@ -61,6 +64,7 @@ static const EnsembleImplMap infoObjectCmds[] = {
|
||||
{"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}
|
||||
@@ -82,6 +86,7 @@ static const EnsembleImplMap infoClassCmds[] = {
|
||||
{"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},
|
||||
@@ -1716,6 +1721,184 @@ InfoClassCallCmd(
|
||||
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
|
||||
|
||||
+39
-9
@@ -160,6 +160,26 @@ typedef struct {
|
||||
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.
|
||||
*/
|
||||
@@ -182,8 +202,8 @@ typedef struct 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. */
|
||||
* 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
|
||||
@@ -211,12 +231,15 @@ typedef struct Object {
|
||||
* 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 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
|
||||
@@ -319,6 +342,9 @@ typedef struct Class {
|
||||
* 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;
|
||||
|
||||
/*
|
||||
@@ -521,6 +547,10 @@ 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,
|
||||
@@ -589,12 +619,12 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
|
||||
/*
|
||||
* 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: Tcl_Size i;
|
||||
* 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) \
|
||||
for(i=0 ; var=&((ary).list[i]), i<(ary).num; i++)
|
||||
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
|
||||
|
||||
+247
-18
@@ -19,7 +19,7 @@
|
||||
/*
|
||||
* The scripted part of the definitions of TclOO.
|
||||
*
|
||||
* Compiled from generic/tclOOScript.tcl by tools/makeHeader.tcl, which
|
||||
* Compiled from tools/tclOOScript.tcl by tools/makeHeader.tcl, which
|
||||
* contains the commented version of everything; *this* file is automatically
|
||||
* generated.
|
||||
*/
|
||||
@@ -29,7 +29,7 @@ static const char *tclOOSetupScript =
|
||||
"::namespace eval ::oo {\n"
|
||||
"\t::namespace path {}\n"
|
||||
"\tnamespace eval Helpers {\n"
|
||||
"\t\t::namespace path {}\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"
|
||||
@@ -98,9 +98,9 @@ static const char *tclOOSetupScript =
|
||||
"\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\tdefine $delegate ::oo::define::superclass -appendifnew $d\n"
|
||||
"\t\t}\n"
|
||||
"\t\tobjdefine $class ::oo::objdefine::mixin -append $delegate\n"
|
||||
"\t\tobjdefine $class ::oo::objdefine::mixin -appendifnew $delegate\n"
|
||||
"\t}\n"
|
||||
"\tproc UpdateClassDelegatesAfterClone {originObject targetObject} {\n"
|
||||
"\t\tset originDelegate [DelegateName $originObject]\n"
|
||||
@@ -141,34 +141,44 @@ static const char *tclOOSetupScript =
|
||||
"\t\t::namespace delete tmp\n"
|
||||
"\t}\n"
|
||||
"\tdefine Slot {\n"
|
||||
"\t\tmethod Get {} {\n"
|
||||
"\t\tmethod Get -unexport {} {\n"
|
||||
"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
|
||||
"\t\t}\n"
|
||||
"\t\tmethod Set list {\n"
|
||||
"\t\tmethod Set -unexport list {\n"
|
||||
"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
|
||||
"\t\t}\n"
|
||||
"\t\tmethod Resolve list {\n"
|
||||
"\t\tmethod Resolve -unexport list {\n"
|
||||
"\t\t\treturn $list\n"
|
||||
"\t\t}\n"
|
||||
"\t\tmethod -set args {\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 args {\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 -clear {} {tailcall my Set {}}\n"
|
||||
"\t\tmethod -prepend args {\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\tset args [lmap a $args {\n"
|
||||
"\t\t\t\tset a [uplevel 1 [list $my Resolve $a]]\n"
|
||||
"\t\t\t\tif {$a in $current} continue\n"
|
||||
"\t\t\t\tset a\n"
|
||||
"\t\t\t}]\n"
|
||||
"\t\t\ttailcall my Set [list {*}$current {*}$args]\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 args {\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"
|
||||
@@ -177,7 +187,7 @@ static const char *tclOOSetupScript =
|
||||
"\t\t\t}]\n"
|
||||
"\t\t}\n"
|
||||
"\t\tforward --default-operation my -append\n"
|
||||
"\t\tmethod unknown {args} {\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"
|
||||
@@ -186,13 +196,12 @@ static const char *tclOOSetupScript =
|
||||
"\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\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> {originObject} {\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"
|
||||
@@ -219,7 +228,7 @@ static const char *tclOOSetupScript =
|
||||
"\t\t\t}\n"
|
||||
"\t\t}\n"
|
||||
"\t}\n"
|
||||
"\tdefine class method <cloned> {originObject} {\n"
|
||||
"\tdefine class method <cloned> -unexport {originObject} {\n"
|
||||
"\t\tnext $originObject\n"
|
||||
"\t\t::oo::UpdateClassDelegatesAfterClone $originObject [self]\n"
|
||||
"\t}\n"
|
||||
@@ -235,7 +244,7 @@ static const char *tclOOSetupScript =
|
||||
"\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\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"
|
||||
@@ -248,6 +257,226 @@ static const char *tclOOSetupScript =
|
||||
"\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. */
|
||||
;
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user