Compare commits

...
136 Commits
Author SHA1 Message Date
pooryorick 674dc6d84e Merge trunk-encoding-defaultstrict [c499122331]. 2023-06-18 21:30:00 +00:00
pooryorick f85eb13554 Merge trunk [7dc0ea8ca5]. 2023-06-12 10:19:50 +00:00
pooryorick 50eb79b797 Merge trunk [19e22d9bc5]. 2023-06-11 21:31:59 +00:00
pooryorick dd66ab423e Merge trunk [402ff62239]. 2023-06-11 20:21:28 +00:00
pooryorick 7600da9e6c Merge trunk [07d84ca4b3]. 2023-06-11 19:53:08 +00:00
pooryorick a1300ad826 Merge trunk [3389fba412]. 2023-06-11 19:41:42 +00:00
pooryorick fea0c84f2f Merge trunk [9d2e82fe49]. 2023-06-11 13:10:31 +00:00
pooryorick 25fb9a6a54 Merge trunk [b06ffa0e0e]. 2023-06-11 08:55:29 +00:00
pooryorick baf1eb36e4 Merge trunk [66350977dd]. 2023-06-11 08:07:01 +00:00
pooryorick 6c22f6b730 Merge trunk [20891426a8]. 2023-06-11 07:29:27 +00:00
pooryorick 2071be71b1 Merge trunk [874005b119] 2023-06-11 05:06:54 +00:00
pooryorick a7c911213a Merge trunk [b60a8ec69f]. 2023-05-20 16:02:09 +00:00
pooryorick b359029baa Merge trunk [c405bdd1f0]. 2023-05-19 12:08:53 +00:00
pooryorick c447bf4370 Merge trunk [402ff62239]. 2023-05-19 12:02:13 +00:00
pooryorick c8c0db5f21 Merge trunk [05eeae5d67] and resolve conflicts. 2023-05-11 21:47:17 +00:00
pooryorick c29132ab84 ptrdiff_t to Tcl_Size in tclListObj.c 2023-05-11 20:59:18 +00:00
pooryorick edbf195dff Add TclRelaxRefCount and TclObjGetScalar, and use them to try to take the fast path more often in byte-compiled [lindex].
See: [https://github.com/tcltk/tcl/actions/runs/4956385513] for build failure
2023-05-11 20:25:49 +00:00
pooryorick 6da79937df remove "forceUniChar" from TclStringCat() since it isn't used anymore. 2023-05-03 16:26:27 +00:00
pooryorick 66c0809095 Merge [842b3b3949]. 2023-05-03 11:31:30 +00:00
pooryorick 5f690c8fae Fix issue [b3628609ad73a105], by allowing TclStringCat to assume that each Tcl_Obj.bytes value is complete, i.e. concatenating such values does not change the interpretatin of any byte in any of the concatenated values. 2023-05-02 19:58:06 +00:00
pooryorick c811b1d642 Merge trunk [480bcbe193]. 2023-05-02 19:51:21 +00:00
pooryorick 50c851a04b Remove "deprecated" constraint in test suite. 2023-05-02 19:42:25 +00:00
pooryorick e1051201ce Merge trunk [6964e7e16a]. 2023-05-02 15:51:01 +00:00
pooryorick 410ffcdefa Fix issue [b3628609ad73a105], by allowing TclStringCat to assume that each
Tcl_Obj.bytes value is complete, i.e. concatenating such values does not change
the interpretatin of any byte in any of the concatenated values.
2023-05-02 12:47:10 +00:00
pooryorick 09dd330c44 Merge trunk [95cb1987c8]. 2023-05-01 09:46:41 +00:00
pooryorick 3458214e46 Delete related to TCL_BUILD_FOR and all code related to it. 2023-04-30 19:30:36 +00:00
pooryorick 0987bb4b63 Remove all code that is conditioned on TCL_MAJOR_VERSION. 2023-04-30 18:36:31 +00:00
pooryorick 64a0be31b9 Remove all code related to TCL_NO_DEPRECATED, and some related to TCL_MAJOR_VERSION. 2023-04-28 23:57:14 +00:00
pooryorick 2098e71e79 Remove TclUtfToUCS4(), TclUniCharToUCS4(), and TclUCS4Prev(). 2023-04-28 19:19:30 +00:00
pooryorick 4a24561f0b Remove all code related to TCL_UTF_MAX=3. 2023-04-28 17:34:24 +00:00
pooryorick df1dd156ed Merge trunk. 2023-04-28 12:20:52 +00:00
pooryorick 1a819d1063 Merge trunk. 2023-04-28 09:03:14 +00:00
pooryorick 6ee4d2b394 Merge trunk. 2023-04-24 00:08:18 +00:00
pooryorick 26c9f5e773 merge trunk [f867f44c9c]. 2023-04-23 11:48:15 +00:00
pooryorick 466e7c47c6 Set the encoding profile to strict in Tcl_FSEvalFileEx(). This is independent
of TIP 657:  A script to be evaluated must be properly encoded in any case.
2023-04-23 11:39:10 +00:00
pooryorick 37dceb3922 Merge trunk-encodingdefaultstrict [31278b27ed]. 2023-04-19 17:39:48 +00:00
pooryorick 0c2d0f0ab7 Merge trunk [08fc7dfb36]. 2023-04-19 17:05:58 +00:00
pooryorick 2fb58dc372 Merge trunk [c2d903f6ed]: apn-bigdata-tests. 2023-04-19 16:41:13 +00:00
pooryorick 2c78daa2b0 Fossil merge [1842599320]: TIP 660 accepted. 2023-04-19 12:20:25 +00:00
pooryorick 02c0281379 Merge trunk [883464ea32]. 2023-04-19 12:15:51 +00:00
pooryorick e736d151a0 Merge trunk-encodingdefaultstrict [d325b41eb8] 2023-04-19 12:11:55 +00:00
pooryorick dcb3b835e4 Merge trunk [1ef347e31d]. 2023-04-19 11:28:22 +00:00
pooryorick e027188168 Merge trunk [5995ca9b6c]. 2023-04-19 11:19:06 +00:00
pooryorick c4c090889c Merge trunk [f9c8bbde44]. 2023-04-19 07:43:57 +00:00
pooryorick 01570cabab Merge trunk [433637e689]. 2023-04-19 07:17:28 +00:00
pooryorick 182b7f85f6 Merge trunk [67baae2829]. 2023-04-18 23:57:32 +00:00
pooryorick e1b3b51a8f Merge trunk [32d5cdd8d0]. 2023-04-18 23:25:24 +00:00
pooryorick 23dd40e1a2 Merge trunk [8dba618fe6]. 2023-04-18 23:24:14 +00:00
pooryorick 9af2fb9efe Merge trunk [f9a80c2c9e]. 2023-04-18 23:22:43 +00:00
pooryorick 1a7bbea40c Merge trunk [4fc1f701cc] and resolve conflicts. 2023-04-18 22:56:24 +00:00
pooryorick aec3f90f4d Merge trunk [0d197907c6]. 2023-04-18 15:32:02 +00:00
pooryorick 198dbe0117 Merge trunk [e7fcdb7611]. 2023-04-18 13:24:40 +00:00
pooryorick 19eccf461d Merge trunk [cbaf88e90a]: Fix iocmd-12.11 testcase. 2023-04-18 13:16:54 +00:00
pooryorick ca96bc096f Merge trunk [a9fc905623] and resolve conflicts and test failures. 2023-04-18 13:05:39 +00:00
pooryorick 034957707a Merge trunk [79cd3ac351]. 2023-04-18 12:24:06 +00:00
pooryorick ce003df1ca Merge trunk [78beedf7e2] and resolve conflicts. 2023-04-18 12:12:41 +00:00
pooryorick 63e2ca9905 Merge trunk [c8983a2a94] and resolve conflicts. 2023-04-18 11:39:12 +00:00
pooryorick 9512351bc5 Merge trunk [48829d9671]: Fix [d7fd37ebd9]: handling leftover prefix in table
encoding.
2023-04-18 10:29:28 +00:00
pooryorick ce353e21ed Merge trunk [1253dd0211]:` Fix http11 test hang caused by trailing brace in
previous commit.
2023-04-18 08:07:56 +00:00
pooryorick fb61224892 Merge trunk [20cad126cd]: Don't let httpd11 depend on the system encoding any
more: All text files are now stored in utf-8.
2023-04-18 08:02:49 +00:00
pooryorick f10942c112 Merge trunk [b10e2b66a9], Tcl TIP 656 manpages. 2023-04-18 07:43:31 +00:00
pooryorick 62e806dc83 Merge trunk [49a4c8f8fb], "TIP 656 accepted", and resolve conflicts. 2023-04-17 21:33:41 +00:00
pooryorick 9831556bf7 Merge trunk [31788d9a4b] and resolve conflicts. 2023-04-17 13:30:36 +00:00
pooryorick 9586d2f54c Merge trunk [1997f71246]. 2023-04-17 11:31:50 +00:00
pooryorick 800f0a1edf Merge trunk [498ef65f88] and resolve conflicts. 2023-04-17 10:58:50 +00:00
pooryorick 304ca9a172 Merge trunk [91094999d0], resolve conflicts, and make Tcl_UtfToExternalDString
strict regarding encoding errors.
2023-04-16 18:30:54 +00:00
pooryorick d7fdb20ed5 Merge trunk [f868c40053] and resolve conflicts. 2023-04-16 17:07:15 +00:00
pooryorick 6e4c20e3a6 Merge trunk [32c5b5172b]. 2023-04-16 16:58:43 +00:00
pooryorick 704627190d Merge trunk [69fba9fb6b]: Fix [4bea02e811]: encoding convertfrom -strict
ascii \x7f generates exception Many other encodings had the same problem, and
also the reverse happened: encodings which should throw an exception with
-strict but didn't (within range 0x80-0x9F).
2023-04-16 16:40:37 +00:00
pooryorick a8075a956d Merge trunk [355a5e4733] and resolve conflicts and test failures. 2023-04-16 16:23:26 +00:00
pooryorick ab1a8089de Merge trunk [f64a19cf62] and resolve conflicts. 2023-04-16 14:05:13 +00:00
pooryorick 9c35850e30 Merge trunk [7b54fc6784]: Fix for [885c86a9a0]: convertfrom utf8 breaks for 4
byte utf encodings.
2023-04-16 13:48:59 +00:00
pooryorick 55bb2e9be3 Merge trunk [fc029613d5]. 2023-04-16 13:31:53 +00:00
pooryorick 0033456148 Merge trunk [e90924bb13]: test encoding-16.17. 2023-04-16 13:23:38 +00:00
pooryorick ce60562f86 Merge trunk [de933019a109d3d6]: Fix for [bd1a60eb9c]: convertfrom utf-8 strict
mode allows surrogates in input sequence.
2023-04-16 13:20:58 +00:00
pooryorick aad734db91 Merge trunk [2d036d968c] and resolve issues. 2023-04-16 08:29:10 +00:00
pooryorick c1ebc6273f Merge trunk [f118b6370b]. 2023-04-15 23:50:38 +00:00
pooryorick e08e3fbc09 Merge trunk [f9cdaa50ad]: First part of fix for [4a7397e0b3]. Not complete yet. 2023-04-15 22:52:02 +00:00
pooryorick ae955d6d24 merge trunk [77c37636f0]: DoReadChars() and Tcl_SetObjLength(). 2023-04-13 06:52:16 +00:00
pooryorick 756913ce13 Merge trunk [d65da06a77]: Correct spelling errors in comments and
documentation, but also a non-comment corections in history.tcl and
tcltest.test.
2023-04-12 14:44:08 +00:00
pooryorick 21fec5d3d1 Merge trunk [b921949acd]: More int -> Tcl_Size, so (theoretically) longer
lists could be handled. Thanks, Rolf!
2023-04-12 14:43:18 +00:00
pooryorick 72557b402d Merge trunk [9c60558723]: int -> Tcl_Size for tclWinDde.c/tclWinReg.c, so it
could (theoretically) handle larger lists in Tcl 9.
2023-04-12 14:42:10 +00:00
pooryorick a1d4fac3d8 Merge trunk [e825ea06803d4a61]: Editorial fix in Tcl_Panic() message. 2023-04-12 14:41:04 +00:00
pooryorick 3e3ef5f0be Merge trunk [b66d50b4d4]: Merge bug-[fa3d9fd818fa0072]. 2023-04-07 21:07:42 +00:00
pooryorick c70c765bc7 Merge trunk [c53063d69b]: TIP 602 - update manpages. 2023-04-07 20:26:47 +00:00
pooryorick a67d7e8610 Merge trunk [e1baa8ec4a]: Make sure that infoPtr->validMask only contains
TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION, no other flags.
2023-04-07 20:25:31 +00:00
pooryorick 2b4d8d160a Merge trunk [b27eacb7fc]: Fix [6390566ecd]: Testcase
cmdAH-4.3.13.00DC0000.tail.utf-32.tcl8.a fails sometimes.
2023-04-07 19:42:05 +00:00
pooryorick 3504682d15 Merge trunk [d29e69a635a0dc81]: TIP #628 addendum (various fixes to improve
handling of 8.7 <-> 9.0 header differences).
2023-04-07 18:43:26 +00:00
pooryorick 065cc78833 Merge trunk. 2023-04-04 18:56:27 +00:00
pooryorick 32aba95cdd Merge trunk. 2023-04-04 18:53:00 +00:00
pooryorick 15dbbaf497 Merge trunk [dc1e0b5f9a]: Minor fix in winConsole.test. 2023-04-04 14:11:05 +00:00
pooryorick f52fe2c0c0 Merge trunk [cbaf88e90a]: Fix iocmd-12.11 testcase. 2023-04-04 14:10:00 +00:00
pooryorick fc1e6cc187 Merge trunk [a9fc9056236f5775] : Fix [fa128568a5]: EOVERFLOW does not
necessarily mean "file too big". Synchronize many error-messages with what
Linux gives nowadays.
2023-04-04 14:08:38 +00:00
pooryorick dff9e4fbb2 Merge trunk [f8864b9541d149d2]: Merge 8.7. POSIX errors update and minizip fix. 2023-04-04 13:57:32 +00:00
pooryorick 92aeea296b Merge trunk [0569b8782f] : Remove unneeded parts from test in fileName.test. 2023-03-28 17:54:13 +00:00
pooryorick 42bbf78a33 Merge trunk [92ee031f32]: Make the documentation of [encoding] more concise
and readable.
2023-03-28 17:52:31 +00:00
pooryorick 04ef72b73b Merge trunk [4ebee22ffd]: Update reference-counting advice for Tcl_ObjSetVar2 and friends. 2023-03-28 17:51:26 +00:00
pooryorick e47a1c3779 Merge trunk [f8927d772b]: Avoid msvc "illegal indirection" error. 2023-03-28 16:32:57 +00:00
pooryorick ce09232ac7 Merge trunk [aa1a1096ac]: Fix memory leak in Tcl_JoinObjCmd(). 2023-03-28 16:32:01 +00:00
pooryorick 0a3bf031ac Merge trunk [79cd3ac351]: Update to tzdata 2023b. 2023-03-28 16:31:20 +00:00
pooryorick e78c831950 Merge trunk [7d005e0860]: Fix for [6d4e9d1af5bf5b7d]: Memory leak:
SetFsPathFromAny, assisted by the global literal table, causes a Tcl_Obj to
reference itself.
2023-03-28 16:30:24 +00:00
pooryorick e284637f4c Merge trunk [bb1378370e]: Fix [68417a8bb3]: No result/LF printed for 64-bit
integer type check.
2023-03-28 16:29:25 +00:00
pooryorick 97195d18a9 Merge trunk [6301de2138]: Fix various typos. 2023-03-28 16:27:57 +00:00
pooryorick 99af05cca8 Merge trunk [b29771bb5f]: Fix duplicate test name. 2023-03-28 16:25:38 +00:00
pooryorick 29a34b9b95 Merge trunk [5075be4f0b]: Add valgrind_each to Makefile.in. 2023-03-28 16:24:43 +00:00
pooryorick 30b1f27305 Merge trunk [82107b50c20baa70]: More TCL_INDEX_NONE. 2023-03-28 07:03:14 +00:00
pooryorick b2687dde17 Merge trunk [f25757b233]: Remove knownProfileBug constraint: this is already
fixed.
2023-03-28 06:51:54 +00:00
pooryorick a0ec63efa5 One missing int -> Tcl_Size change 2023-03-27 22:42:33 +00:00
pooryorick e1fca6fb5d Merge trunk [f4cf3c36b4] : Fix [0265750233]: invalid read in cmdAH-4.3.13.C1.solo.utf-8.tcl8 2023-03-27 22:36:04 +00:00
pooryorick 0fcfcc0f88 Merge trunk f8d60e395f: Move (TCL_ENCODING_PROFILE_MASK|GET|SET) from tcl.h to tclIO.h, since those are not public. Some formatting. 2023-03-24 13:27:08 +00:00
pooryorick 1852320cca Merge trunk e1cfef6bfd: Code cleanup: use more *SURROGATE() macros. 2023-03-24 13:25:14 +00:00
pooryorick 79e893e6f2 Merge trunk a9d278979e: Fix longIs64Bit->has64BitLengths else test will not run on 64-bit
Wind.
2023-03-24 13:20:27 +00:00
pooryorick 4232bc484d Merge trunk: Remove unneeded Tcl_IncrRefCount and TclDecrRefCount.
TclPtrSetVarIdx takes ownership of newValuePtr if its refCount is 0, and either
stores or frees it.
2023-03-24 13:19:44 +00:00
pooryorick af2c18d5ea Merge trunk 78beedf7e2: Fix [1bedc53c8c]: synchronous [read] with
-strictencoding does not produce an error on invalid input.
2023-03-24 13:18:51 +00:00
pooryorick fadb579028 Merge trunk c8983a2a94: Fix [154ed7ce56]: Tcl 9: [gets] on -strictencoding 1 configured
channel.
2023-03-24 13:16:26 +00:00
pooryorick ed01d27700 Merge trunk 037b767147: Missing backslashes in macro def. 2023-03-24 13:14:07 +00:00
pooryorick 09b9930667 Merge trunk dd8e66c296: More TclNewIndexObj() usages (for values between -1 and
SIZE_MAX-1).
2023-03-24 13:13:23 +00:00
pooryorick 657095d29a Merge trunk d89991c58b Fix [bdcb5126c0]: Failed assertion in test chan-io-7.3. 2023-03-23 21:38:14 +00:00
pooryorick 05277ab690 Merge trunk 15c9067453: Add longIs64bit constraint to lseq-4.4 (because this
isn't expected to work on 32-bit platforms). Remove some unused constraints.
2023-03-23 21:35:30 +00:00
pooryorick 333b4efa28 Merge trunk 1e23dd4876: Fix [5ae5ffc3f4]: Problem with -failindex on 32-bit platform. 2023-03-23 21:33:03 +00:00
pooryorick adbdca59a9 Merge trunk 1253dd0211: Fix http11 test hang caused by trailing brace in
previous commit.
2023-03-23 21:24:02 +00:00
pooryorick 2918f547d8 Merge trunk 20cad126cd: Don't let httpd11 depend on the system encoding any
more: All text files are now stored in utf-8.
2023-03-23 21:17:33 +00:00
pooryorick c52403ad33 Test TableFromUtfProc() with strict handling of encoding errors. 2023-01-25 19:56:57 +00:00
pooryorick 2b343d0207 Merge trunk. 2023-01-25 00:34:51 +00:00
pooryorick 5363b1f11f Rename [encoding convert*] option "-nocomplain"/"-ignore" to "-pass", and
"-nocomplainencoding"/"-encodingignore" to "-encodingpass".
2023-01-23 21:32:43 +00:00
pooryorick b49efc9ae0 Rename [encoding convert*] option "-nocomplain"/"-ignore" to "-pass", and
"-nocomplainencoding"/"-encodingignore" to  "-encodingpass"
2023-01-23 20:41:47 +00:00
pooryorick 7fe77d7ff8 Per TIP 601, the default behaviour of [encoding convert..] is to require valid input. 2023-01-23 13:53:51 +00:00
pooryorick f54d9a7c69 A branch for fixing TIP 346/601 issues, and other issues related to Unicode
encoding, while retaining the default of not raising an error when invalid data
for the encoding occurs.
2023-01-23 10:48:17 +00:00
pooryorick 9832ae4232 Fix issue with new options parsing in EncodingConvertfromObjCmd
EncodingConverttoObjCmd.
2023-01-22 11:45:56 +00:00
pooryorick 388bc52075 Merge trunk and resolve conflicts, including changing option processing for
EncodingConverttoObjCmd() and EncodingConvertfromObjCmd().
2023-01-20 00:19:38 +00:00
pooryorick 2c039a780e Add tests to verify the default behaviour for encoding errors. 2023-01-12 09:03:40 +00:00
pooryorick 5c70426f61 For [read] and [gets] encoding errors, used "-result read" in return options
dictionary instead of just "-result".
2023-01-08 00:01:50 +00:00
pooryorick d2fa0702bc Fix for [154ed7ce56], Tcl 9: [gets] on -strictencoding 1 configured channel. 2023-01-02 21:07:02 +00:00
pooryorick 530d3a7f83 Merge py-b8f575aa23. 2022-12-31 00:44:04 +00:00
pooryorick f98272ec1e Strict encoding conformance everywhere by default. Full test suite passes. 2022-12-29 18:11:24 +00:00
pooryorick ba64c646ee Unify TCL_ENCODING_STRICT and TCL_ENCODING_NOCOMPLAIN, and make strict encoding
conformance the default everywhere.
2022-12-28 23:35:24 +00:00
58 changed files with 585 additions and 2181 deletions
-2
View File
@@ -15,8 +15,6 @@ jobs:
matrix:
cfgopt:
- ""
- "CFLAGS=-DTCL_UTF_MAX=3"
- "CFLAGS=-DTCL_NO_DEPRECATED=1"
- "--disable-shared"
- "--enable-symbols"
- "--enable-symbols=mem"
-2
View File
@@ -60,8 +60,6 @@ jobs:
matrix:
cfgopt:
- ""
- "CFLAGS=-DTCL_UTF_MAX=3"
- "CFLAGS=-DTCL_NO_DEPRECATED=1"
- "--disable-shared"
- "--enable-symbols"
- "--enable-symbols=mem"
-36
View File
@@ -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
-6
View File
@@ -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.
+19 -108
View File
@@ -208,10 +208,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 +317,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 +449,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;
/*
@@ -608,10 +582,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
/*
*----------------------------------------------------------------------------
@@ -883,11 +853,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 +967,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 +1084,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 +1253,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 +1803,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 +1825,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,7 +1881,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_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
@@ -1958,11 +1906,7 @@ 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 */
@@ -1975,11 +1919,7 @@ typedef struct Tcl_EncodingType {
#define TCL_ENCODING_PROFILE_TCL8 0x01000000
#define TCL_ENCODING_PROFILE_STRICT 0x02000000
#define TCL_ENCODING_PROFILE_REPLACE 0x03000000
#if TCL_MAJOR_VERSION < 9
#define TCL_ENCODING_PROFILE_DEFAULT TCL_ENCODING_PROFILE_TCL8
#else
#define TCL_ENCODING_PROFILE_DEFAULT TCL_ENCODING_PROFILE_TCL8
#endif
#define TCL_ENCODING_PROFILE_DEFAULT TCL_ENCODING_PROFILE_STRICT
/*
* The following definitions are the error codes returned by the conversion
@@ -2021,11 +1961,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
/*
@@ -2033,16 +1969,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
/*
*----------------------------------------------------------------------------
@@ -2229,11 +2161,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
@@ -2255,19 +2183,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), \
@@ -2279,9 +2195,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))
@@ -2313,9 +2227,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);
@@ -2330,7 +2241,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() \
+4 -33
View File
@@ -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 */
void *numBytesPtr) /* If non-NULL, write the number of bytes
* in the array here */
{
Tcl_Size numBytes = 0;
unsigned char *bytes = Tcl_GetBytesFromObj(interp, objPtr, &numBytes);
if (bytes && numBytesPtr) {
if (numBytes > INT_MAX) {
/* Caller asked for numBytes to be written to an int, but the
* value is outside the int range. */
if (interp) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"byte sequence length exceeds INT_MAX", -1));
Tcl_SetErrorCode(interp, "TCL", "API", "OUTDATED", NULL);
}
return NULL;
} else {
*(int *)numBytesPtr = (int) numBytes;
}
}
return bytes;
}
#endif
/*
*----------------------------------------------------------------------
@@ -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;
@@ -2561,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(
@@ -3026,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 %"
@@ -3201,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(
+1 -1
View File
@@ -435,7 +435,7 @@ EncodingConvertParseOptions (
Tcl_Encoding encoding;
Tcl_Obj *dataObj;
Tcl_Obj *failVarObj;
int profile = TCL_ENCODING_PROFILE_TCL8;
int profile = TCL_ENCODING_PROFILE_STRICT;
/*
* Possible combinations:
+2 -2
View File
@@ -5465,8 +5465,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
+9 -13
View File
@@ -1217,7 +1217,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 +1263,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);
@@ -1431,11 +1431,6 @@ StringIndexCmd(
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));
}
}
@@ -1896,7 +1891,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 +2519,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 +2528,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 +2590,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;
}
+2 -2
View File
@@ -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);
-12
View File
@@ -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;
/*
@@ -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 */
/*
+14 -160
View File
@@ -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
@@ -4027,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, (sizePtr)) : \
tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (Tcl_Size *)(void *)(sizePtr)))
# define Tcl_GetStringFromObj(objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
tclStubsPtr->tclGetStringFromObj(objPtr, (sizePtr)) : \
tclStubsPtr->tcl_GetStringFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
# define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
tclStubsPtr->tclGetUnicodeFromObj(objPtr, (sizePtr)) : \
tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
# endif
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
(tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), \
#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, (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, (sizePtr)) : \
tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
#endif
#else
#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
TclGetBytesFromObj(interp, objPtr, (sizePtr)) : \
(Tcl_GetBytesFromObj)(interp, objPtr, (Tcl_Size *)(void *)(sizePtr)))
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \
(flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \
Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
#define Tcl_GetBoolean(interp, src, boolPtr) \
((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \
Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
#define Tcl_GetStringFromObj(objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
TclGetStringFromObj(objPtr, (sizePtr)) : \
(Tcl_GetStringFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr)))
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
TclGetBytesFromObj(NULL, objPtr, (sizePtr)) : \
(Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
TclGetUnicodeFromObj(objPtr, (sizePtr)) : \
(Tcl_GetUnicodeFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr)))
(Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr))
#endif
#ifdef TCL_MEM_DEBUG
@@ -4126,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 \
@@ -4169,36 +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)
#if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED)
# undef Tcl_ListObjGetElements
# define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \
? tclStubsPtr->tclListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)) \
: tclStubsPtr->tcl_ListObjGetElements((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr)))
# undef Tcl_ListObjLength
# define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \
? tclStubsPtr->tclListObjLength((interp), (listPtr), (lengthPtr)) \
: tclStubsPtr->tcl_ListObjLength((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr)))
# undef Tcl_DictObjSize
# define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \
? tclStubsPtr->tclDictObjSize((interp), (dictPtr), (sizePtr)) \
: tclStubsPtr->tcl_DictObjSize((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr)))
# undef Tcl_SplitList
# define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
? tclStubsPtr->tclSplitList((interp), (listStr), (argcPtr), (argvPtr)) \
: tclStubsPtr->tcl_SplitList((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
# undef Tcl_SplitPath
# define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
? tclStubsPtr->tclSplitPath((path), (argcPtr), (argvPtr)) \
: tclStubsPtr->tcl_SplitPath((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
# undef Tcl_FSSplitPath
# define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \
? tclStubsPtr->tclFSSplitPath((pathPtr), (lenPtr)) \
: tclStubsPtr->tcl_FSSplitPath((pathPtr), (Tcl_Size *)(void *)(lenPtr)))
# undef Tcl_ParseArgsObjv
# define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \
? tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) \
: tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv)))
#endif /* TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED) */
#else
# define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_UniCharToUtfDString \
@@ -4212,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), (objcPtr), (objvPtr)) \
: (Tcl_ListObjGetElements)((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr)))
# define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \
? TclListObjLength((interp), (listPtr), (lengthPtr)) \
: (Tcl_ListObjLength)((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr)))
# define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \
? TclDictObjSize((interp), (dictPtr), (sizePtr)) \
: (Tcl_DictObjSize)((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr)))
# define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
? TclSplitList((interp), (listStr), (argcPtr), (argvPtr)) \
: (Tcl_SplitList)((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
# define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
? TclSplitPath((path), (argcPtr), (argvPtr)) \
: (Tcl_SplitPath)((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
# define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \
? TclFSSplitPath((pathPtr), (lenPtr)) \
: (Tcl_FSSplitPath)((pathPtr), (Tcl_Size *)(void *)(lenPtr)))
# define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \
? TclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) \
: (Tcl_ParseArgsObjv)((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv)))
#endif /* !defined(BUILD_tcl) */
#endif
/*
@@ -4246,24 +4113,11 @@ extern const TclStubs *tclStubsPtr;
#define Tcl_GlobalEvalObj(interp, objPtr) \
Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
#if TCL_MAJOR_VERSION > 8
# undef Tcl_Close
# define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
#endif
# undef 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
/* TIP #660 for 8.7 */
#if TCL_MAJOR_VERSION < 9
# undef Tcl_GetSizeIntFromObj
# define Tcl_GetSizeIntFromObj Tcl_GetIntFromObj
#endif
#endif /* _TCLDECLS */
+1 -1
View File
@@ -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);
+14 -174
View File
@@ -655,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
@@ -1154,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);
}
@@ -1628,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,
@@ -2531,16 +2526,6 @@ UtfToUtfProc(
flags |= PTR2INT(clientData);
dstEnd = dst + dstLen - ((flags & ENCODING_UTF) ? TCL_UTF_MAX : 6);
#if TCL_UTF_MAX < 4
/* Initialize the buffer so that some random data doesn't trick
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
* prior non-stateful nature, this call to memset can also be removed.
*/
memset(dst, 0xff, dstLen);
#endif
profile = ENCODING_PROFILE_GET(flags);
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
@@ -2588,10 +2573,10 @@ UtfToUtfProc(
} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
/*
* Incomplete byte sequence.
* Always check before using TclUtfToUCS4. Not doing so can cause it
* run beyond the end of the buffer! If we happen on such an incomplete
* char its bytes are made to represent themselves unless the user has
* explicitly asked to be told.
* 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.
*/
if (flags & ENCODING_INPUT) {
@@ -2610,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;
@@ -2643,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,15 +2706,6 @@ Utf32ToUtfProc(
}
result = TCL_OK;
#if TCL_UTF_MAX < 4
/* Initialize the buffer so that some random data doesn't trick
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
* prior non-stateful nature, this call to memset can also be removed.
*/
memset(dst, 0xff, dstLen);
#endif
/*
* Check alignment with utf-32 (4 == sizeof(UTF-32))
*/
@@ -2773,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;
@@ -2800,20 +2727,11 @@ Utf32ToUtfProc(
break;
}
#if TCL_UTF_MAX < 4
int prev = ch;
#endif
if (flags & TCL_ENCODING_LE) {
ch = (unsigned int)(src[3] & 0xFF) << 24 | (src[2] & 0xFF) << 16 | (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
} else {
ch = (unsigned int)(src[0] & 0xFF) << 24 | (src[1] & 0xFF) << 16 | (src[2] & 0xFF) << 8 | (src[3] & 0xFF);
}
#if TCL_UTF_MAX < 4
if (HIGH_SURROGATE(prev) && !LOW_SURROGATE(ch)) {
/* Bug [10c2c17c32]. If Hi surrogate not followed by Lo surrogate, finish 3-byte UTF-8 */
dst += Tcl_UniCharToUtf(-1, dst);
}
#endif
if ((unsigned)ch > 0x10FFFF) {
ch = UNICODE_REPLACE_CHAR;
@@ -2823,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;
@@ -2839,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;
@@ -2853,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;
@@ -2952,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;
@@ -3033,15 +2936,6 @@ Utf16ToUtfProc(
}
result = TCL_OK;
#if TCL_UTF_MAX < 4
/* Initialize the buffer so that some random data doesn't trick
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
* prior non-stateful nature, this call to memset can also be removed.
*/
memset(dst, 0xff, dstLen);
#endif
/*
* Check alignment with utf-16 (2 == sizeof(UTF-16))
*/
@@ -3240,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;
@@ -3349,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)) {
@@ -3369,7 +3252,6 @@ UtfToUcs2Proc(
}
ch = UNICODE_REPLACE_CHAR;
}
#endif
if (PROFILE_STRICT(flags) && SURROGATE(ch)) {
result = TCL_CONVERT_SYNTAX;
break;
@@ -3455,15 +3337,6 @@ TableToUtfProc(
dstStart = dst;
dstEnd = dst + dstLen - TCL_UTF_MAX;
#if TCL_UTF_MAX < 4
/* Initialize the buffer so that some random data doesn't trick
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
* prior non-stateful nature, this call to memset can also be removed.
*/
memset(dst, 0xff, dstLen);
#endif
toUnicode = (const unsigned short *const *) dataPtr->toUnicode;
prefixBytes = dataPtr->prefixBytes;
pageZero = toUnicode[0];
@@ -3608,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)) {
@@ -3705,15 +3573,6 @@ Iso88591ToUtfProc(
dstStart = dst;
dstEnd = dst + dstLen - TCL_UTF_MAX;
#if TCL_UTF_MAX < 4
/* Initialize the buffer so that some random data doesn't trick
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
* prior non-stateful nature, this call to memset can also be removed.
*/
memset(dst, 0xff, dstLen);
#endif
result = TCL_OK;
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
Tcl_UniChar ch = 0;
@@ -3815,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 */
}
@@ -3953,15 +3802,6 @@ EscapeToUtfProc(
dstStart = dst;
dstEnd = dst + dstLen - TCL_UTF_MAX;
#if TCL_UTF_MAX < 4
/* Initialize the buffer so that some random data doesn't trick
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
* prior non-stateful nature, this call to memset can also be removed.
*/
memset(dst, 0xff, dstLen);
#endif
state = PTR2INT(*statePtr);
if (flags & TCL_ENCODING_START) {
state = 0;
-6
View File
@@ -1088,9 +1088,6 @@ static const struct {
#ifdef USE_NMAKE
".nmake"
#endif
#ifdef TCL_NO_DEPRECATED
".no-deprecate"
#endif
#if !TCL_THREADS
".no-thread"
#endif
@@ -1112,9 +1109,6 @@ static const struct {
#ifdef STATIC_BUILD
".static"
#endif
#if TCL_UTF_MAX < 4
".utf-16"
#endif
}};
const char *
+1 -7
View File
@@ -4725,7 +4725,6 @@ TEBCresume(
Tcl_ResetResult(interp);
}
}
DECACHE_STACK_INFO();
objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
CACHE_STACK_INFO();
@@ -5322,11 +5321,6 @@ TEBCresume(
TclNewObj(objResultPtr);
} else {
slength = Tcl_UniCharToUtf(ch, buf);
#if TCL_UTF_MAX < 4
if ((ch >= 0xD800) && (slength < 3)) {
slength += Tcl_UniCharToUtf(-1, buf + slength);
}
#endif
objResultPtr = Tcl_NewStringObj(buf, slength);
}
}
@@ -5538,7 +5532,7 @@ TEBCresume(
int ch;
end = ustring1 + slength;
for (p=ustring1 ; p<end ; ) {
p += TclUniCharToUCS4(p, &ch);
ch = *p++;
if (!tclStringClassTable[opnd].comparator(ch)) {
match = 0;
break;
+11 -4
View File
@@ -1664,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 */
/*
@@ -1681,11 +1685,11 @@ Tcl_CreateChannel(
statePtr->inputEncodingState = NULL;
statePtr->inputEncodingFlags = TCL_ENCODING_START;
ENCODING_PROFILE_SET(statePtr->inputEncodingFlags,
TCL_ENCODING_PROFILE_TCL8);
TCL_ENCODING_PROFILE_DEFAULT);
statePtr->outputEncodingState = NULL;
statePtr->outputEncodingFlags = TCL_ENCODING_START;
ENCODING_PROFILE_SET(statePtr->outputEncodingFlags,
TCL_ENCODING_PROFILE_TCL8);
TCL_ENCODING_PROFILE_DEFAULT);
/*
* Set the channel up initially in AUTO input translation mode to accept
@@ -5931,6 +5935,7 @@ DoReadChars(
ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR);
/* TODO: UpdateInterest not needed here? */
UpdateInterest(chanPtr);
Tcl_SetErrno(EILSEQ);
return -1;
}
@@ -6031,6 +6036,7 @@ DoReadChars(
if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
&& !GotFlag(statePtr, CHANNEL_STICKY_EOF)
&& (!GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
copied = -1;
goto finish;
}
}
@@ -6110,6 +6116,9 @@ finish:
copied = -1;
}
TclChannelRelease((Tcl_Channel)chanPtr);
if (copied == TCL_INDEX_NONE) {
ResetFlag(statePtr, CHANNEL_ENCODING_ERROR|CHANNEL_EOF);
}
return copied;
}
@@ -8205,9 +8214,7 @@ Tcl_SetChannelOption(
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];
-4
View File
@@ -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. */
+16 -4
View File
@@ -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;
}
+5
View File
@@ -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);
+2 -66
View File
@@ -225,9 +225,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;
/*
@@ -277,11 +275,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
@@ -962,9 +956,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. */
@@ -975,12 +966,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
@@ -1038,11 +1027,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
@@ -1881,18 +1866,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.
@@ -1921,12 +1895,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.
*/
@@ -1949,9 +1917,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
@@ -1989,9 +1954,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. */
@@ -2648,20 +2610,11 @@ 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) \
? (*(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) \
@@ -3122,7 +3075,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,
@@ -3334,6 +3286,7 @@ 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 void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, const char *operation,
const char *reason, int index);
@@ -3490,15 +3443,6 @@ MODULE_SCOPE void TclRegisterCommandTypeName(
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,
@@ -4254,7 +4198,6 @@ MODULE_SCOPE int TclIndexInvalidError(Tcl_Interp *interp,
*/
MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, Tcl_Size count);
#endif /* TCL_MAJOR_VERSION > 8 */
/* Constants used in index value encoding routines. */
#define TCL_INDEX_END ((Tcl_Size)-2)
@@ -4767,17 +4710,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
/*
*----------------------------------------------------------------
@@ -4840,7 +4776,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 */
-9
View File
@@ -1281,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()
-543
View File
@@ -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))
-6
View File
@@ -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;
-16
View File
@@ -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;
-7
View File
@@ -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);
}
+74 -50
View File
@@ -1704,6 +1704,80 @@ TclSetDuplicateObj(
TclFreeInternalRep(dupPtr);
SetDuplicateObj(dupPtr, objPtr);
}
/*
*----------------------------------------------------------------------
*
* TclObjGetScaler --
*
* Without perturbing any existing internal represenation, returns objPtr
* itself if it has an internal scalar type, is the empty list, or if the
* Tcl_Obj is list a containing only one scalar element, tries to returns
* scalar Tcl_Obj from that one item.
*
* Returns NULL if the Tcl_Obj is not scalar.
*
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclObjGetScalar(Tcl_Obj *objPtr)
{
Tcl_ObjType const *typePtr = objPtr->typePtr;
if (typePtr == &tclDictType) {
if (TclDictGetSize(objPtr) == 0) {
return objPtr;
} else {
return NULL;
}
}
if (TclHasInternalRep(objPtr, NULL) && objPtr->bytes != &tclEmptyString) {
void *ClientDataPtr;
int numTypePtr;
if (Tcl_GetNumberFromObj(NULL, objPtr, &ClientDataPtr, &numTypePtr) != TCL_OK) {
Tcl_Size length;
/* convert to list */
Tcl_ListObjLength(NULL, objPtr, &length);
}
}
if (typePtr == &tclIntType.objType
|| typePtr == &tclDoubleType.objType
|| typePtr == &tclBignumType.objType
) {
return objPtr;
}
if (typePtr == &tclListType.objType) {
if (TclListObjIsCanonical(objPtr)) {
Tcl_Size objc;
TclListObjLengthM(NULL, objPtr, &objc);
if (objc == 1) {
Tcl_Obj *elem, *elem2;
Tcl_IncrRefCount(objPtr);
elem = TclListObjGetElement(objPtr, 0);
Tcl_IncrRefCount(elem);
Tcl_DecrRefCount(objPtr);
elem2 = TclObjGetScalar(elem);
if (elem2) {
Tcl_IncrRefCount(elem2);
Tcl_DecrRefCount(elem);
TclUndoRefCount(elem2);
} else {
Tcl_DecrRefCount(elem);
}
return elem2;
} else if (objc == 0) {
return objPtr;
}
} else {
return NULL;
}
}
if (TclCheckEmptyString(objPtr)) {
return objPtr;
}
return NULL;
}
/*
*----------------------------------------------------------------------
@@ -1783,52 +1857,7 @@ Tcl_GetString(
*----------------------------------------------------------------------
*/
#if !defined(TCL_NO_DEPRECATED)
char *
TclGetStringFromObj(
Tcl_Obj *objPtr, /* Object whose string rep byte pointer should
* be returned. */
void *lengthPtr) /* If non-NULL, the location where the string
* rep's byte array length should * be stored.
* If NULL, no length is stored. */
{
if (objPtr->bytes == NULL) {
/*
* Note we do not check for objPtr->typePtr == NULL. An invariant
* of a properly maintained Tcl_Obj is that at least one of
* objPtr->bytes and objPtr->typePtr must not be NULL. If broken
* extensions fail to maintain that invariant, we can crash here.
*/
if (objPtr->typePtr->updateStringProc == NULL) {
/*
* Those Tcl_ObjTypes which choose not to define an
* updateStringProc must be written in such a way that
* (objPtr->bytes) never becomes NULL.
*/
Tcl_Panic("UpdateStringProc should not be invoked for type %s",
objPtr->typePtr->name);
}
objPtr->typePtr->updateStringProc(objPtr);
if (objPtr->bytes == NULL || objPtr->length == TCL_INDEX_NONE
|| objPtr->bytes[objPtr->length] != '\0') {
Tcl_Panic("UpdateStringProc for type '%s' "
"failed to create a valid string rep",
objPtr->typePtr->name);
}
}
if (lengthPtr != NULL) {
if (objPtr->length > INT_MAX) {
Tcl_Panic("Tcl_GetStringFromObj with 'int' lengthPtr"
" cannot handle such long strings. Please use 'Tcl_Size'");
}
*(int *)lengthPtr = (int)objPtr->length;
}
return objPtr->bytes;
}
#endif /* !defined(TCL_NO_DEPRECATED) */
#undef Tcl_GetStringFromObj
char *
Tcl_GetStringFromObj(
Tcl_Obj *objPtr, /* Object whose string rep byte pointer should
@@ -2122,7 +2151,6 @@ Tcl_FreeInternalRep(
*----------------------------------------------------------------------
*/
#undef Tcl_GetBoolFromObj
int
Tcl_GetBoolFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
@@ -2192,7 +2220,6 @@ Tcl_GetBoolFromObj(
return TCL_ERROR;
}
#undef Tcl_GetBooleanFromObj
int
Tcl_GetBooleanFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
@@ -2409,7 +2436,6 @@ ParseBoolean(
*/
#ifdef TCL_MEM_DEBUG
#undef Tcl_NewDoubleObj
Tcl_Obj *
Tcl_NewDoubleObj(
@@ -2886,7 +2912,6 @@ Tcl_GetLongFromObj(
*/
#ifdef TCL_MEM_DEBUG
#undef Tcl_NewWideIntObj
Tcl_Obj *
Tcl_NewWideIntObj(
@@ -3403,7 +3428,6 @@ UpdateStringOfBignum(
*/
#ifdef TCL_MEM_DEBUG
#undef Tcl_NewBignumObj
Tcl_Obj *
Tcl_NewBignumObj(
+2 -20
View File
@@ -871,18 +871,6 @@ TclParseBackslash(
* No hexdigits -> This is just "u".
*/
result = 'u';
#if TCL_UTF_MAX < 4
} else if (((result & 0xFC00) == 0xD800) && (count == 6)
&& (p[5] == '\\') && (p[6] == 'u') && (numBytes >= 10)) {
/* If high surrogate is immediately followed by a low surrogate
* escape, combine them into one character. */
int low;
int count2 = ParseHex(p+7, 4, &low);
if ((count2 == 4) && ((low & 0xFC00) == 0xDC00)) {
result = ((result & 0x3FF)<<10 | (low & 0x3FF)) + 0x10000;
count += count2 + 2;
}
#endif
}
break;
case 'U':
@@ -938,13 +926,13 @@ TclParseBackslash(
*/
if (Tcl_UtfCharComplete(p, numBytes - 1)) {
count = TclUtfToUCS4(p, &unichar) + 1; /* +1 for '\' */
count = Tcl_UtfToUniChar(p, &unichar) + 1; /* +1 for '\' */
} else {
char utfBytes[8];
memcpy(utfBytes, p, numBytes - 1);
utfBytes[numBytes - 1] = '\0';
count = TclUtfToUCS4(utfBytes, &unichar) + 1;
count = Tcl_UtfToUniChar(utfBytes, &unichar) + 1;
}
result = unichar;
break;
@@ -955,12 +943,6 @@ TclParseBackslash(
*readPtr = count;
}
count = Tcl_UniCharToUtf(result, dst);
#if TCL_UTF_MAX < 4
if ((result >= 0xD800) && (count < 3)) {
/* Special case for handling high surrogates. */
count += Tcl_UniCharToUtf(-1, dst + count);
}
#endif
return count;
}
+1 -90
View File
@@ -48,93 +48,6 @@
# endif
#endif
#if TCL_MAJOR_VERSION < 9
#ifdef __cplusplus
extern "C" {
#endif
/*
* Exported function declarations:
*/
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len,
Tcl_DString *dsPtr);
/* 1 */
EXTERN char * Tcl_WinTCharToUtf(const TCHAR *str, int len,
Tcl_DString *dsPtr);
/* Slot 2 is reserved */
/* 3 */
EXTERN void Tcl_WinConvertError(unsigned errCode);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
EXTERN int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
const char *bundleName, int hasResourceFile,
int maxPathLen, char *libraryPath);
/* 1 */
EXTERN int Tcl_MacOSXOpenVersionedBundleResources(
Tcl_Interp *interp, const char *bundleName,
const char *bundleVersion,
int hasResourceFile, int maxPathLen,
char *libraryPath);
/* 2 */
EXTERN void Tcl_MacOSXNotifierAddRunLoopMode(
const void *runLoopMode);
#endif /* MACOSX */
typedef struct TclPlatStubs {
int magic;
void *hooks;
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
void (*reserved2)(void);
void (*tcl_WinConvertError) (unsigned errCode); /* 3 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */
int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */
void (*tcl_MacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 2 */
#endif /* MACOSX */
} TclPlatStubs;
extern const TclPlatStubs *tclPlatStubsPtr;
#ifdef __cplusplus
}
#endif
#if defined(USE_TCL_STUBS)
/*
* Inline function declarations:
*/
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define Tcl_WinUtfToTChar \
(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
#define Tcl_WinTCharToUtf \
(tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */
/* Slot 2 is reserved */
#define Tcl_WinConvertError \
(tclPlatStubsPtr->tcl_WinConvertError) /* 3 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#define Tcl_MacOSXOpenBundleResources \
(tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */
#define Tcl_MacOSXOpenVersionedBundleResources \
(tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */
#define Tcl_MacOSXNotifierAddRunLoopMode \
(tclPlatStubsPtr->tcl_MacOSXNotifierAddRunLoopMode) /* 2 */
#endif /* MACOSX */
#endif /* defined(USE_TCL_STUBS) */
#else /* TCL_MAJOR_VERSION > 8 */
/* !BEGIN!: Do not edit below this line. */
@@ -193,7 +106,6 @@ extern const TclPlatStubs *tclPlatStubsPtr;
/* !END!: Do not edit above this line. */
#endif /* TCL_MAJOR_VERSION */
#ifdef MAC_OSX_TCL /* MACOSX */
#undef Tcl_MacOSXOpenBundleResources
@@ -213,8 +125,7 @@ extern const TclPlatStubs *tclPlatStubsPtr;
# undef Tcl_MacOSXNotifierAddRunLoopMode
#endif
#if defined(USE_TCL_STUBS) && (defined(_WIN32) || defined(__CYGWIN__))\
&& (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8)
#if defined(USE_TCL_STUBS) && (defined(_WIN32) || defined(__CYGWIN__))
#undef Tcl_WinUtfToTChar
#undef Tcl_WinTCharToUtf
#ifdef _WIN32
+1 -1
View File
@@ -903,7 +903,7 @@ Tcl_ScanObjCmd(
* Scan a single Unicode character.
*/
offset = TclUtfToUCS4(string, &i);
offset = Tcl_UtfToUniChar(string, &i);
string += offset;
if (!(flags & SCAN_SUPPRESS)) {
TclNewIntObj(objPtr, i);
+6 -141
View File
@@ -67,16 +67,6 @@ static void SetUnicodeObj(Tcl_Obj *objPtr,
static Tcl_Size UnicodeLength(const Tcl_UniChar *unicode);
static void UpdateStringOfString(Tcl_Obj *objPtr);
#if TCL_UTF_MAX > 3
#define ISCONTINUATION(bytes) (\
((bytes)[0] & 0xC0) == 0x80)
#else
#define ISCONTINUATION(bytes) (\
((((bytes)[0] & 0xC0) == 0x80) || (((bytes)[0] == '\xED') \
&& (((bytes)[1] & 0xF0) == 0xB0) && (((bytes)[2] & 0xC0) == 0x80))))
#endif
/*
* The structure below defines the string Tcl object type by means of
* functions that can be invoked by generic object code.
@@ -589,22 +579,6 @@ Tcl_GetUniChar(
return -1;
}
ch = stringPtr->unicode[index];
#if TCL_UTF_MAX < 4
/* See: bug [11ae2be95dac9417] */
if ((ch & 0xF800) == 0xD800) {
if (ch & 0x400) {
if ((index > 0)
&& ((stringPtr->unicode[index-1] & 0xFC00) == 0xD800)) {
ch = -1; /* low surrogate preceded by high surrogate */
}
} else if ((++index < stringPtr->numChars)
&& ((stringPtr->unicode[index] & 0xFC00) == 0xDC00)) {
/* high surrogate followed by low surrogate */
ch = (((ch & 0x3FF) << 10) |
(stringPtr->unicode[index] & 0x3FF)) + 0x10000;
}
}
#endif
return ch;
}
@@ -666,36 +640,6 @@ TclGetUniChar(
*/
#undef Tcl_GetUnicodeFromObj
#if !defined(TCL_NO_DEPRECATED)
Tcl_UniChar *
TclGetUnicodeFromObj(
Tcl_Obj *objPtr, /* The object to find the Unicode string
* for. */
void *lengthPtr) /* If non-NULL, the location where the string
* rep's Tcl_UniChar length should be stored. If
* NULL, no length is stored. */
{
String *stringPtr;
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
if (lengthPtr != NULL) {
if (stringPtr->numChars > INT_MAX) {
Tcl_Panic("Tcl_GetUnicodeFromObj with 'int' lengthPtr"
" cannot handle such long strings. Please use 'Tcl_Size'");
}
*(int *)lengthPtr = (int)stringPtr->numChars;
}
return stringPtr->unicode;
}
#endif /* !defined(TCL_NO_DEPRECATED) */
Tcl_UniChar *
Tcl_GetUnicodeFromObj(
Tcl_Obj *objPtr, /* The object to find the unicode string
@@ -816,18 +760,6 @@ Tcl_GetRange(
TclNewObj(newObjPtr);
return newObjPtr;
}
#if TCL_UTF_MAX < 4
/* See: bug [11ae2be95dac9417] */
if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00)
&& ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) {
++first;
}
if ((last + 1 < stringPtr->numChars)
&& ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00)
&& ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) {
++last;
}
#endif
return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
}
@@ -1283,12 +1215,6 @@ Tcl_AppendLimitedToObj(
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
/* If appended string starts with a continuation byte or a lower surrogate,
* force objPtr to unicode representation. See [7f1162a867] */
if (bytes && ISCONTINUATION(bytes)) {
Tcl_GetUnicode(objPtr);
stringPtr = GET_STRING(objPtr);
}
if (stringPtr->hasUnicode && (stringPtr->numChars) > 0) {
AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
} else {
@@ -1488,13 +1414,6 @@ Tcl_AppendObjToObj(
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
/* If appended string starts with a continuation byte or a lower surrogate,
* force objPtr to unicode representation. See [7f1162a867]
* This fixes append-3.4, append-3.7 and utf-1.18 testcases. */
if (ISCONTINUATION(TclGetString(appendObjPtr))) {
Tcl_GetUnicode(objPtr);
stringPtr = GET_STRING(objPtr);
}
/*
* If objPtr has a valid Unicode rep, then get a Unicode string from
* appendObjPtr and append it.
@@ -2157,12 +2076,6 @@ Tcl_AppendFormatToObj(
code = 0xFFFD;
}
length = Tcl_UniCharToUtf(code, buf);
#if TCL_UTF_MAX < 4
if ((code >= 0xD800) && (length < 3)) {
/* Special case for handling high surrogates. */
length += Tcl_UniCharToUtf(-1, buf + length);
}
#endif
segment = Tcl_NewStringObj(buf, length);
Tcl_IncrRefCount(segment);
allocSegment = 1;
@@ -3124,7 +3037,7 @@ TclStringCat(
Tcl_Obj *objResultPtr, * const *ov;
int binary = 1;
Tcl_Size oc, length = 0;
int allowUniChar = 1, requestUniChar = 0, forceUniChar = 0;
int allowUniChar = 1, requestUniChar = 0;
Tcl_Size first = objc - 1; /* Index of first value possibly not empty */
Tcl_Size last = 0; /* Index of last value possibly not empty */
int inPlace = (flags & TCL_STRING_IN_PLACE) && !Tcl_IsShared(*objv);
@@ -3166,9 +3079,7 @@ TclStringCat(
*/
binary = 0;
if (ov > objv+1 && ISCONTINUATION(TclGetString(objPtr))) {
forceUniChar = 1;
} else if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
/* Prevent shimmer of non-string types. */
allowUniChar = 0;
}
@@ -3218,7 +3129,7 @@ TclStringCat(
}
}
} while (--oc);
} else if ((allowUniChar && requestUniChar) || forceUniChar) {
} else if ((allowUniChar && requestUniChar)) {
/*
* Result will be pure Tcl_UniChar array. Pre-size it.
*/
@@ -3375,7 +3286,7 @@ TclStringCat(
dst += more;
}
}
} else if ((allowUniChar && requestUniChar) || forceUniChar) {
} else if ((allowUniChar && requestUniChar)) {
/* Efficiently produce a pure Tcl_UniChar array result */
Tcl_UniChar *dst;
@@ -3567,7 +3478,7 @@ TclStringCmp(
s1 = (char *) Tcl_GetUnicode(value1Ptr);
s2 = (char *) Tcl_GetUnicode(value2Ptr);
if (
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
#if defined(WORDS_BIGENDIAN)
1
#else
checkEq
@@ -3927,9 +3838,6 @@ TclStringReverse(
String *stringPtr;
Tcl_UniChar ch = 0;
int inPlace = flags & TCL_STRING_IN_PLACE;
#if TCL_UTF_MAX < 4
int needFlip = 0;
#endif
if (TclIsPureByteArray(objPtr)) {
Tcl_Size numBytes = 0;
@@ -3962,54 +3870,19 @@ TclStringReverse(
to = Tcl_GetUnicode(objPtr);
stringPtr = GET_STRING(objPtr);
while (--src >= from) {
#if TCL_UTF_MAX < 4
ch = *src;
if ((ch & 0xF800) == 0xD800) {
needFlip = 1;
}
*to++ = ch;
#else
*to++ = *src;
#endif
}
} else {
/*
* Reversing in place.
*/
#if TCL_UTF_MAX < 4
to = src;
#endif
while (--src > from) {
ch = *src;
#if TCL_UTF_MAX < 4
if ((ch & 0xF800) == 0xD800) {
needFlip = 1;
}
#endif
*src = *from;
*from++ = ch;
}
}
#if TCL_UTF_MAX < 4
if (needFlip) {
/*
* Flip back surrogate pairs.
*/
from = to - stringPtr->numChars;
while (--to >= from) {
ch = *to;
if ((ch & 0xFC00) == 0xD800) {
if ((to-1 >= from) && ((to[-1] & 0xFC00) == 0xDC00)) {
to[0] = to[-1];
to[-1] = ch;
--to;
}
}
}
}
#endif
}
if (objPtr->bytes) {
@@ -4043,7 +3916,7 @@ TclStringReverse(
* skip calling Tcl_UtfCharComplete() here.
*/
int bytesInChar = TclUtfToUCS4(from, &chw);
int bytesInChar = Tcl_UtfToUniChar(from, &chw);
ReverseBytes((unsigned char *)to, (unsigned char *)from,
bytesInChar);
@@ -4492,14 +4365,6 @@ ExtendStringRepWithUnicode(
copyBytes:
dst = objPtr->bytes + origLength;
#if TCL_UTF_MAX < 4
/* Initialize the buffer so that some random data doesn't trick
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
* prior non-stateful nature, this call to memset can also be removed.
*/
memset(dst, 0xff, stringPtr->allocated - origLength);
#endif
for (i = 0; i < numChars; i++) {
dst += Tcl_UniCharToUtf(unicode[i], dst);
}
+1 -113
View File
@@ -79,16 +79,12 @@
# undef Tcl_WinConvertError
# define Tcl_WinConvertError 0
#endif
#if defined(TCL_NO_DEPRECATED)
# undef TclGetStringFromObj
# undef TclGetBytesFromObj
# undef TclGetUnicodeFromObj
# define TclGetStringFromObj 0
# define TclGetBytesFromObj 0
# if TCL_UTF_MAX > 3
# define TclGetUnicodeFromObj 0
# endif
#endif
# define TclGetUnicodeFromObj 0
#undef Tcl_Close
#define Tcl_Close 0
#undef TclGetByteArrayFromObj
@@ -97,23 +93,10 @@
#define Tcl_GetByteArrayFromObj 0
#define TclUnusedStubEntry 0
#if TCL_UTF_MAX < 4
static void uniCodePanic() {
Tcl_Panic("This extension uses a deprecated function, not available now: Tcl is compiled with -DTCL_UTF_MAX==%d", TCL_UTF_MAX);
}
# define Tcl_GetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, Tcl_Size *))(void *)uniCodePanic
# define TclGetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, int *))(void *)uniCodePanic
# define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
# define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
# define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
#endif
#define TclUtfCharComplete Tcl_UtfCharComplete
#define TclUtfNext Tcl_UtfNext
#define TclUtfPrev Tcl_UtfPrev
#if defined(TCL_NO_DEPRECATED)
# define TclListObjGetElements 0
# define TclListObjLength 0
# define TclDictObjSize 0
@@ -121,101 +104,6 @@ static void uniCodePanic() {
# define TclSplitPath 0
# define TclFSSplitPath 0
# define TclParseArgsObjv 0
#else /* !defined(TCL_NO_DEPRECATED) */
int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
void *objcPtr, Tcl_Obj ***objvPtr) {
Tcl_Size n = TCL_INDEX_NONE;
int result = Tcl_ListObjGetElements(interp, listPtr, &n, objvPtr);
if (objcPtr) {
if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
if (interp) {
Tcl_AppendResult(interp, "List too large to be processed", NULL);
}
return TCL_ERROR;
}
*(int *)objcPtr = (int)n;
}
return result;
}
int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
void *lengthPtr) {
Tcl_Size n = TCL_INDEX_NONE;
int result = Tcl_ListObjLength(interp, listPtr, &n);
if (lengthPtr) {
if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
if (interp) {
Tcl_AppendResult(interp, "List too large to be processed", NULL);
}
return TCL_ERROR;
}
*(int *)lengthPtr = (int)n;
}
return result;
}
int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
void *sizePtr) {
Tcl_Size n = TCL_INDEX_NONE;
int result = Tcl_DictObjSize(interp, dictPtr, &n);
if (sizePtr) {
if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
if (interp) {
Tcl_AppendResult(interp, "Dict too large to be processed", NULL);
}
return TCL_ERROR;
}
*(int *)sizePtr = (int)n;
}
return result;
}
int TclSplitList(Tcl_Interp *interp, const char *listStr, void *argcPtr,
const char ***argvPtr) {
Tcl_Size n = TCL_INDEX_NONE;
int result = Tcl_SplitList(interp, listStr, &n, argvPtr);
if (argcPtr) {
if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
if (interp) {
Tcl_AppendResult(interp, "List too large to be processed", NULL);
}
Tcl_Free((void *)*argvPtr);
return TCL_ERROR;
}
*(int *)argcPtr = (int)n;
}
return result;
}
void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr) {
Tcl_Size n = TCL_INDEX_NONE;
Tcl_SplitPath(path, &n, argvPtr);
if (argcPtr) {
if ((sizeof(int) != sizeof(size_t)) && (n > INT_MAX)) {
n = TCL_INDEX_NONE; /* No other way to return an error-situation */
Tcl_Free((void *)*argvPtr);
*argvPtr = NULL;
}
*(int *)argcPtr = (int)n;
}
}
Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr) {
Tcl_Size n = TCL_INDEX_NONE;
Tcl_Obj *result = Tcl_FSSplitPath(pathPtr, &n);
if (lenPtr) {
if ((sizeof(int) != sizeof(size_t)) && result && (n > INT_MAX)) {
Tcl_DecrRefCount(result);
return NULL;
}
*(int *)lenPtr = (int)n;
}
return result;
}
int TclParseArgsObjv(Tcl_Interp *interp,
const Tcl_ArgvInfo *argTable, void *objcPtr, Tcl_Obj *const *objv,
Tcl_Obj ***remObjv) {
Tcl_Size n = (*(int *)objcPtr < 0) ? TCL_INDEX_NONE: (Tcl_Size)*(int *)objcPtr ;
int result = Tcl_ParseArgsObjv(interp, argTable, &n, objv, remObjv);
*(int *)objcPtr = (int)n;
return result;
}
#endif /* !defined(TCL_NO_DEPRECATED) */
#define TclBN_mp_add mp_add
#define TclBN_mp_add_d mp_add_d
-17
View File
@@ -515,9 +515,6 @@ static const char version[] = TCL_PATCH_LEVEL "+" STRINGIFY(TCL_VERSION_UUID)
#ifdef STATIC_BUILD
".static"
#endif
#if TCL_UTF_MAX < 4
".utf-16"
#endif
;
int
@@ -546,12 +543,10 @@ Tcltest_Init(
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
#if TCL_MAJOR_VERSION > 8
if (info.isNativeObjectProc == 2) {
Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
info.objProc2, (void *)version, NULL);
} else
#endif
Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
info.objProc, (void *)version, NULL);
}
@@ -810,12 +805,10 @@ Tcltest_SafeInit(
return TCL_ERROR;
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
#if TCL_MAJOR_VERSION > 8
if (info.isNativeObjectProc == 2) {
Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
info.objProc2, (void *)version, NULL);
} else
#endif
Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
info.objProc, (void *)version, NULL);
}
@@ -5758,17 +5751,7 @@ TestbytestringObjCmd(
Tcl_Obj *const objv[]) /* The argument objects. */
{
struct {
#if !defined(TCL_NO_DEPRECATED)
# if defined(_MSC_VER) && !defined(NDEBUG)
# pragma warning(disable:4133)
# elif defined(__clang__)
# pragma clang diagnostic push
# pragma clang diagnostic ignored "-Wincompatible-pointer-types"
# endif
int n; /* On purpose, not Tcl_Size, in order to demonstrate what happens */
#else
Tcl_Size n;
#endif
int m; /* This variable should not be overwritten */
} x = {0, 1};
const char *p;
+2 -16
View File
@@ -195,7 +195,6 @@ static const unsigned short pageMap[] = {
1344, 1344, 1344, 10112, 10144, 1344, 10176, 1344, 10208, 10240, 10272,
10304, 10336, 10368, 1344, 1344, 1344, 10400, 10432, 64, 10464, 10496,
10528, 4736, 10560, 10592
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
,10624, 10656, 10688, 3296, 1344, 1344, 1344, 10720, 10752, 10784,
10816, 10848, 10880, 10912, 10944, 10976, 3296, 3296, 3296, 3296, 9216,
1344, 11008, 11040, 1344, 11072, 11104, 11136, 11168, 1344, 11200,
@@ -568,8 +567,6 @@ static const unsigned short pageMap[] = {
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 15520
#endif /* TCL_UTF_MAX > 3 */
};
/*
@@ -1180,7 +1177,6 @@ static const unsigned char groupMap[] = {
15, 15, 15, 0, 0, 15, 15, 15, 0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0, 14,
7, 7, 7, 7, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 14, 14,
0, 0
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
,15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
@@ -1653,8 +1649,6 @@ static const unsigned char groupMap[] = {
15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
#endif /* TCL_UTF_MAX > 3 */
};
/*
@@ -1702,11 +1696,7 @@ static const int groups[] = {
18, 17, 10305, 10370, 10049, 10114, 8769, 8834
};
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= 0x323C0)
#else
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1F0000) != 0)
#endif
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= 0x323C0)
/*
* The following constants are used to determine the category of a
@@ -1761,8 +1751,4 @@ enum {
* Unicode character tables.
*/
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1FFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
#else
# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0xFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
#endif
# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1FFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
+12 -172
View File
@@ -215,9 +215,7 @@ Tcl_UniCharToUtf(
* character (at most 4 bytes).
*/
{
#if TCL_UTF_MAX > 3
int flags = ch;
#endif
if (ch >= TCL_COMBINE) {
ch &= (TCL_COMBINE - 1);
@@ -234,9 +232,7 @@ Tcl_UniCharToUtf(
}
if (ch <= 0xFFFF) {
if (
#if TCL_UTF_MAX > 3
(flags & TCL_COMBINE) &&
#endif
((ch & 0xF800) == 0xD800)) {
if (ch & 0x0400) {
/* Low surrogate */
@@ -349,15 +345,6 @@ Tcl_UniCharToUtfDString(
p = string;
wEnd = uniStr + uniLength;
#if TCL_UTF_MAX < 4
/* Initialize the buffer so that some random data doesn't trick
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
* prior non-stateful nature, this call to memset can also be removed.
*/
memset(p, 0xff, Tcl_DStringLength(dsPtr) - oldLength);
#endif
for (w = uniStr; w < wEnd; ) {
p += Tcl_UniCharToUtf(*w, p);
w++;
@@ -402,15 +389,6 @@ Tcl_Char16ToUtfDString(
p = string;
wEnd = uniStr + uniLength;
#if TCL_UTF_MAX < 4
/* Initialize the buffer so that some random data doesn't trick
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
* Because TCL_COMBINE is used here, memset() is required even when
* TCL_UTF_MAX == 4.
*/
memset(p, 0xff, Tcl_DStringLength(dsPtr) - oldLength);
#endif
for (w = uniStr; w < wEnd; ) {
if (!len && ((*w & 0xFC00) != 0xDC00)) {
/* Special case for handling high surrogates. */
@@ -447,15 +425,6 @@ Tcl_Char16ToUtfDString(
* Tcl_UtfCharComplete() before calling this routine to ensure that
* enough bytes remain in the string.
*
* If TCL_UTF_MAX < 4, special handling of Surrogate pairs is done:
* For any UTF-8 string containing a character outside of the BMP, the
* first call to this function will fill *chPtr with the high surrogate
* and generate a return value of 1. Calling Tcl_UtfToUniChar again
* will produce the low surrogate and a return value of 3. Because *chPtr
* is used to remember whether the high surrogate is already produced, it
* is recommended to initialize the variable it points to as 0 before
* the first call to Tcl_UtfToUniChar is done.
*
* Results:
* *chPtr is filled with the Tcl_UniChar, and the return value is the
* number of bytes from the UTF-8 string that were consumed.
@@ -715,11 +684,11 @@ Tcl_UtfToUniCharDString(
endPtr = src + length;
optPtr = endPtr - 4;
while (p <= optPtr) {
p += TclUtfToUCS4(p, &ch);
p += Tcl_UtfToUniChar(p, &ch);
*w++ = ch;
}
while ((p < endPtr) && Tcl_UtfCharComplete(p, endPtr-p)) {
p += TclUtfToUCS4(p, &ch);
p += Tcl_UtfToUniChar(p, &ch);
*w++ = ch;
}
while (p < endPtr) {
@@ -965,7 +934,7 @@ Tcl_UtfFindFirst(
int ch) /* The Unicode character to search for. */
{
while (1) {
int find, len = TclUtfToUCS4(src, &find);
int find, len = Tcl_UtfToUniChar(src, &find);
if (find == ch) {
return src;
@@ -1004,7 +973,7 @@ Tcl_UtfFindLast(
const char *last = NULL;
while (1) {
int find, len = TclUtfToUCS4(src, &find);
int find, len = Tcl_UtfToUniChar(src, &find);
if (find == ch) {
last = src;
@@ -1227,13 +1196,7 @@ Tcl_UniCharAtIndex(
i = TclUtfToUniChar(src, &ch);
src += i;
}
#if TCL_UTF_MAX < 4
if ((ch >= 0xD800) && (i < 3)) {
/* Index points at character following high Surrogate */
return -1;
}
#endif
TclUtfToUCS4(src, &i);
Tcl_UtfToUniChar(src, &i);
return i;
}
@@ -1242,10 +1205,8 @@ Tcl_UniCharAtIndex(
*
* Tcl_UtfAtIndex --
*
* Returns a pointer to the specified character (not byte) position in
* the UTF-8 string. If TCL_UTF_MAX < 4, characters > U+FFFF count as
* 2 positions, but then the pointer should never be placed between
* the two positions.
* Returns a pointer to the specified character (not byte) position in the
* UTF-8 string.
*
* Results:
* As above.
@@ -1377,7 +1338,7 @@ Tcl_UtfToUpper(
src = dst = str;
while (*src) {
len = TclUtfToUCS4(src, &ch);
len = Tcl_UtfToUniChar(src, &ch);
upChar = Tcl_UniCharToUpper(ch);
/*
@@ -1430,7 +1391,7 @@ Tcl_UtfToLower(
src = dst = str;
while (*src) {
len = TclUtfToUCS4(src, &ch);
len = Tcl_UtfToUniChar(src, &ch);
lowChar = Tcl_UniCharToLower(ch);
/*
@@ -1486,7 +1447,7 @@ Tcl_UtfToTitle(
src = dst = str;
if (*src) {
len = TclUtfToUCS4(src, &ch);
len = Tcl_UtfToUniChar(src, &ch);
titleChar = Tcl_UniCharToTitle(ch);
if (len < TclUtfCount(titleChar)) {
@@ -1498,7 +1459,7 @@ Tcl_UtfToTitle(
src += len;
}
while (*src) {
len = TclUtfToUCS4(src, &ch);
len = Tcl_UtfToUniChar(src, &ch);
lowChar = ch;
/* Special exception for Georgian Asomtavruli chars, no titlecase. */
if ((unsigned)(lowChar - 0x1C90) >= 0x30) {
@@ -1605,16 +1566,6 @@ Tcl_UtfNcmp(
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX < 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
}
#endif
return (ch1 - ch2);
}
}
@@ -1656,16 +1607,6 @@ Tcl_UtfNcasecmp(
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX < 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
}
#endif
ch1 = Tcl_UniCharToLower(ch1);
ch2 = Tcl_UniCharToLower(ch2);
if (ch1 != ch2) {
@@ -1705,16 +1646,6 @@ TclUtfCmp(
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX < 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
}
#endif
return ch1 - ch2;
}
}
@@ -1751,16 +1682,6 @@ TclUtfCasecmp(
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX < 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
}
#endif
ch1 = Tcl_UniCharToLower(ch1);
ch2 = Tcl_UniCharToLower(ch2);
if (ch1 != ch2) {
@@ -1959,7 +1880,7 @@ TclUniCharNcmp(
const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */
size_t numChars) /* Number of unichars to compare. */
{
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
#if defined(WORDS_BIGENDIAN)
/*
* We are definitely on a big-endian machine; memcmp() is safe
*/
@@ -1973,14 +1894,6 @@ TclUniCharNcmp(
for ( ; numChars != 0; ucs++, uct++, numChars--) {
if (*ucs != *uct) {
#if TCL_UTF_MAX < 4
/* special case for handling upper surrogates */
if (((*ucs & 0xFC00) == 0xD800) && ((*uct & 0xFC00) != 0xD800)) {
return 1;
} else if (((*uct & 0xFC00) == 0xD800)) {
return -1;
}
#endif
return (*ucs - *uct);
}
}
@@ -2018,14 +1931,6 @@ TclUniCharNcasecmp(
Tcl_UniChar lct = Tcl_UniCharToLower(*uct);
if (lcs != lct) {
#if TCL_UTF_MAX < 4
/* special case for handling upper surrogates */
if (((lcs & 0xFC00) == 0xD800) && ((lct & 0xFC00) != 0xD800)) {
return 1;
} else if (((lct & 0xFC00) == 0xD800)) {
return -1;
}
#endif
return (lcs - lct);
}
}
@@ -2752,71 +2657,6 @@ TclUniCharMatch(
}
}
/*
*---------------------------------------------------------------------------
*
* TclUtfToUCS4 --
*
* Extracts the 4-byte codepoint from the leading bytes of the
* Modified UTF-8 string "src". This is a utility routine to
* contain the surrogate gymnastics in one place.
*
* The caller must ensure that the source buffer is long enough that this
* routine does not run off the end and dereference non-existent memory
* looking for trail bytes. If the source buffer is known to be '\0'
* terminated, this cannot happen. Otherwise, the caller should call
* Tcl_UtfCharComplete() before calling this routine to ensure that
* enough bytes remain in the string.
*
* Results:
* Fills *usc4Ptr with the UCS4 code point and returns the number of bytes
* consumed from the source string.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
#if TCL_UTF_MAX < 4
int
TclUtfToUCS4(
const char *src, /* The UTF-8 string. */
int *ucs4Ptr) /* Filled with the UCS4 codepoint represented
* by the UTF-8 string. */
{
/* Make use of the #undef Tcl_UtfToUniChar above, which already handles UCS4. */
return Tcl_UtfToUniChar(src, ucs4Ptr);
}
int
TclUniCharToUCS4(
const Tcl_UniChar *src, /* The Tcl_UniChar string. */
int *ucs4Ptr) /* Filled with the UCS4 codepoint represented
* by the Tcl_UniChar string. */
{
if (((src[0] & 0xFC00) == 0xD800) && ((src[1] & 0xFC00) == 0xDC00)) {
*ucs4Ptr = (((src[0] & 0x3FF) << 10) | (src[1] & 0x3FF)) + 0x10000;
return 2;
}
*ucs4Ptr = src[0];
return 1;
}
const Tcl_UniChar *TclUCS4Prev(const Tcl_UniChar *src, const Tcl_UniChar *ptr) {
if (src <= ptr + 1) {
return ptr;
}
if (((src[-1] & 0xFC00) == 0xDC00) && ((src[-2] & 0xFC00) == 0xD800)) {
return src - 2;
}
return src - 1;
}
#endif
/*
* Local Variables:
* mode: c
+15 -15
View File
@@ -1670,7 +1670,7 @@ TclTrimRight(
pp = Tcl_UtfPrev(p, bytes);
do {
pp += pInc;
pInc = TclUtfToUCS4(pp, &ch1);
pInc = Tcl_UtfToUniChar(pp, &ch1);
} while (pp + pInc < p);
/*
@@ -1678,7 +1678,7 @@ TclTrimRight(
*/
do {
pInc = TclUtfToUCS4(q, &ch2);
pInc = Tcl_UtfToUniChar(q, &ch2);
if (ch1 == ch2) {
break;
@@ -1743,7 +1743,7 @@ TclTrimLeft(
*/
do {
Tcl_Size pInc = TclUtfToUCS4(p, &ch1);
Tcl_Size pInc = Tcl_UtfToUniChar(p, &ch1);
const char *q = trim;
Tcl_Size bytesLeft = numTrim;
@@ -1752,7 +1752,7 @@ TclTrimLeft(
*/
do {
Tcl_Size qInc = TclUtfToUCS4(q, &ch2);
Tcl_Size qInc = Tcl_UtfToUniChar(q, &ch2);
if (ch1 == ch2) {
break;
@@ -1819,7 +1819,7 @@ TclTrim(
if (numBytes > 0) {
int ch;
const char *first = bytes + trimLeft;
bytes += TclUtfToUCS4(first, &ch);
bytes += Tcl_UtfToUniChar(first, &ch);
numBytes -= (bytes - first);
if (numBytes > 0) {
@@ -2149,7 +2149,7 @@ Tcl_StringCaseMatch(
ch2 = (int)
(nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
} else {
TclUtfToUCS4(pattern, &ch2);
Tcl_UtfToUniChar(pattern, &ch2);
if (nocase) {
ch2 = Tcl_UniCharToLower(ch2);
}
@@ -2165,7 +2165,7 @@ Tcl_StringCaseMatch(
if ((p != '[') && (p != '?') && (p != '\\')) {
if (nocase) {
while (*str) {
charLen = TclUtfToUCS4(str, &ch1);
charLen = Tcl_UtfToUniChar(str, &ch1);
if (ch2==ch1 || ch2==Tcl_UniCharToLower(ch1)) {
break;
}
@@ -2179,7 +2179,7 @@ Tcl_StringCaseMatch(
*/
while (*str) {
charLen = TclUtfToUCS4(str, &ch1);
charLen = Tcl_UtfToUniChar(str, &ch1);
if (ch2 == ch1) {
break;
}
@@ -2193,7 +2193,7 @@ Tcl_StringCaseMatch(
if (*str == '\0') {
return 0;
}
str += TclUtfToUCS4(str, &ch1);
str += Tcl_UtfToUniChar(str, &ch1);
}
}
@@ -2204,7 +2204,7 @@ Tcl_StringCaseMatch(
if (p == '?') {
pattern++;
str += TclUtfToUCS4(str, &ch1);
str += Tcl_UtfToUniChar(str, &ch1);
continue;
}
@@ -2223,7 +2223,7 @@ Tcl_StringCaseMatch(
(nocase ? tolower(UCHAR(*str)) : UCHAR(*str));
str++;
} else {
str += TclUtfToUCS4(str, &ch1);
str += Tcl_UtfToUniChar(str, &ch1);
if (nocase) {
ch1 = Tcl_UniCharToLower(ch1);
}
@@ -2237,7 +2237,7 @@ Tcl_StringCaseMatch(
? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
pattern++;
} else {
pattern += TclUtfToUCS4(pattern, &startChar);
pattern += Tcl_UtfToUniChar(pattern, &startChar);
if (nocase) {
startChar = Tcl_UniCharToLower(startChar);
}
@@ -2252,7 +2252,7 @@ Tcl_StringCaseMatch(
? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
pattern++;
} else {
pattern += TclUtfToUCS4(pattern, &endChar);
pattern += Tcl_UtfToUniChar(pattern, &endChar);
if (nocase) {
endChar = Tcl_UniCharToLower(endChar);
}
@@ -2300,8 +2300,8 @@ Tcl_StringCaseMatch(
* each string match.
*/
str += TclUtfToUCS4(str, &ch1);
pattern += TclUtfToUCS4(pattern, &ch2);
str += Tcl_UtfToUniChar(str, &ch1);
pattern += Tcl_UtfToUniChar(pattern, &ch2);
if (nocase) {
if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
return 0;
+3 -24
View File
@@ -1746,9 +1746,6 @@ proc http::OpenSocket {token DoLater} {
}
fconfigure $sock -translation {auto crlf} \
-buffersize $state(-blocksize)
if {[package vsatisfies [package provide Tcl] 9.0-]} {
fconfigure $sock -profile tcl8
}
##Log socket opened, DONE fconfigure - token $token
}
@@ -2167,9 +2164,6 @@ proc http::Connected {token proto phost srvurl} {
lassign [fconfigure $sock -translation] trRead trWrite
fconfigure $sock -translation [list $trRead crlf] \
-buffersize $state(-blocksize)
if {[package vsatisfies [package provide Tcl] 9.0-]} {
fconfigure $sock -profile tcl8
}
# The following is disallowed in safe interpreters, but the socket is
# already in non-blocking mode in that case.
@@ -2560,9 +2554,6 @@ proc http::ReceiveResponse {token} {
lassign [fconfigure $sock -translation] trRead trWrite
fconfigure $sock -translation [list auto $trWrite] \
-buffersize $state(-blocksize)
if {[package vsatisfies [package provide Tcl] 9.0-]} {
fconfigure $sock -profile tcl8
}
Log ^D$tk begin receiving response - token $token
coroutine ${token}--EventCoroutine http::Event $sock $token
@@ -4554,11 +4545,7 @@ proc http::Eot {token {reason {}}} {
set enc [CharsetToEncoding $state(charset)]
if {$enc ne "binary"} {
if {[package vsatisfies [package provide Tcl] 9.0-]} {
set state(body) [encoding convertfrom -profile tcl8 $enc $state(body)]
} else {
set state(body) [encoding convertfrom $enc $state(body)]
}
set state(body) [encoding convertfrom $enc $state(body)]
}
# Translate text line endings.
@@ -4641,11 +4628,7 @@ proc http::GuessType {token} {
if {$enc eq "binary"} {
return 0
}
if {[package vsatisfies [package provide Tcl] 9.0-]} {
set state(body) [encoding convertfrom -profile tcl8 $enc $state(body)]
} else {
set state(body) [encoding convertfrom $enc $state(body)]
}
set state(body) [encoding convertfrom $enc $state(body)]
set state(body) [string map {\r\n \n \r \n} $state(body)]
set state(type) application/xml
set state(binary) 0
@@ -4726,11 +4709,7 @@ proc http::quoteString {string} {
# a pre-computed map and [string map] to do the conversion (much faster
# than [regsub]/[subst]). [Bug 1020491]
if {[package vsatisfies [package provide Tcl] 9.0-]} {
set string [encoding convertto -profile tcl8 $http(-urlencoding) $string]
} else {
set string [encoding convertto $http(-urlencoding) $string]
}
set string [encoding convertto $http(-urlencoding) $string]
return [string map $formMap $string]
}
+10 -13
View File
@@ -400,7 +400,7 @@ namespace eval tcltest {
default {
set outputChannel [open $filename a]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $outputChannel -profile tcl8 -encoding utf-8
fconfigure $outputChannel -encoding utf-8
}
set ChannelsWeOpened($outputChannel) 1
@@ -447,7 +447,7 @@ namespace eval tcltest {
default {
set errorChannel [open $filename a]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $errorChannel -profile tcl8 -encoding utf-8
fconfigure $errorChannel -encoding utf-8
}
set ChannelsWeOpened($errorChannel) 1
@@ -792,7 +792,7 @@ namespace eval tcltest {
if {$Option(-loadfile) eq {}} {return}
set tmp [open $Option(-loadfile) r]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $tmp -profile tcl8 -encoding utf-8
fconfigure $tmp -encoding utf-8
}
loadScript [read $tmp]
close $tmp
@@ -1134,6 +1134,7 @@ proc tcltest::SafeFetch {n1 n2 op} {
}
}
# tcltest::Asciify --
#
# Transforms the passed string to contain only printable ascii characters.
@@ -1371,7 +1372,7 @@ proc tcltest::DefineConstraintInitializers {} {
set code 0
if {![catch {set f [open "|[list [interpreter]]" w]}]} {
if {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $f -profile tcl8 -encoding utf-8
fconfigure $f -encoding utf-8
}
if {![catch {puts $f exit}]} {
if {![catch {close $f}]} {
@@ -2221,7 +2222,7 @@ proc tcltest::test {name description args} {
if {[file readable $testFile]} {
set testFd [open $testFile r]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $testFd -profile tcl8 -encoding utf-8
fconfigure $testFd -encoding utf-8
}
set testLine [expr {[lsearch -regexp \
[split [read $testFd] "\n"] \
@@ -2252,11 +2253,7 @@ proc tcltest::test {name description args} {
if {$scriptCompare} {
puts [outputChannel] "---- Error testing result: $scriptMatch"
} else {
if {[catch {
puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]"
} errMsg]} {
puts [outputChannel] "\n---- Result was:\n<error printing result: $errMsg>"
}
puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]"
puts [outputChannel] "---- Result should have been\
($match matching):\n[Asciify $result]"
}
@@ -2936,7 +2933,7 @@ proc tcltest::runAllTests { {shell ""} } {
incr numTestFiles
set pipeFd [open $cmd "r"]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $pipeFd -profile tcl8 -encoding utf-8
fconfigure $pipeFd -encoding utf-8
}
while {[gets $pipeFd line] >= 0} {
if {[regexp [join {
@@ -3136,7 +3133,7 @@ proc tcltest::makeFile {contents name {directory ""}} {
set fd [open $fullName w]
fconfigure $fd -translation lf
if {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $fd -profile tcl8 -encoding utf-8
fconfigure $fd -encoding utf-8
}
if {[string index $contents end] eq "\n"} {
puts -nonewline $fd $contents
@@ -3287,7 +3284,7 @@ proc tcltest::viewFile {name {directory ""}} {
set fullName [file join $directory $name]
set f [open $fullName]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $f -profile tcl8 -encoding utf-8
fconfigure $f -encoding utf-8
}
set data [read -nonewline $f]
close $f
+3 -3
View File
@@ -72,15 +72,15 @@ test append-3.6 {append surrogates} -body {
test append-3.7 {append \xC0 \x80} -constraints testbytestring -body {
set x [testbytestring \xC0]
string length [append x [testbytestring \x80]]
} -result 2
} -result 1
test append-3.8 {append \xC0 \x80} -constraints testbytestring -body {
set x [testbytestring \xC0]
string length $x[testbytestring \x80]
} -result 2
} -result 1
test append-3.9 {append \xC0 \x80} -constraints testbytestring -body {
set x [testbytestring \x80]
string length [testbytestring \xC0]$x
} -result 2
} -result 1
test append-3.10 {append surrogates} -body {
set x \uD83D
string range $x 0 end
-3
View File
@@ -3042,9 +3042,6 @@ test binary-80.3 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes
test binary-80.4 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body {
testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xF0\x9F\x98\x81"]
} -result "expected byte sequence but character 4 was '\U01F601' (U+01F601)"
test binary-80.5 {Tcl_GetBytesFromObj} -constraints testbytestring -constraints {pointerIs64bit deprecated} -body {
testbytestring [string repeat A [expr 2**31]]
} -returnCodes 1 -result "byte sequence length exceeds INT_MAX"
# ----------------------------------------------------------------------
# cleanup
+1 -1
View File
@@ -56,7 +56,7 @@ test chan-4.2 {chan command: [Bug 800753]} -body {
test chan-4.3 {chan command: [Bug 800753]} -body {
chan configure stdout -eofchar \x00
} -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character}
test chan-4.4 {chan command: check valid inValue, no outValue} -constraints deprecated -body {
test chan-4.4 {chan command: check valid inValue, no outValue} -body {
chan configure stdout -eofchar [list \x27 {}]
} -result {}
test chan-4.5 {chan command: check valid inValue, invalid outValue} -body {
+2 -2
View File
@@ -5287,7 +5287,7 @@ test chan-io-39.21 {Tcl_SetChannelOption, setting read mode independently} \
test chan-io-39.22 {Tcl_SetChannelOption, invariance} -setup {
file delete $path(test1)
set l ""
} -constraints {unix deprecated} -body {
} -constraints unix -body {
set f1 [open $path(test1) w+]
lappend l [chan configure $f1 -eofchar]
chan configure $f1 -eofchar {O {}}
@@ -5297,7 +5297,7 @@ test chan-io-39.22 {Tcl_SetChannelOption, invariance} -setup {
} -cleanup {
chan close $f1
} -result {{} O D}
test chan-io-39.22a {Tcl_SetChannelOption, invariance} -constraints deprecated -setup {
test chan-io-39.22a {Tcl_SetChannelOption, invariance} -setup {
file delete $path(test1)
set l [list]
} -body {
-1
View File
@@ -334,7 +334,6 @@ test cmdAH-4.2.2 {Tcl_EncodingObjCmd} -setup {
} -cleanup {
encoding system $system
} -result iso8859-1
#
# encoding convertfrom 4.3.*
+21 -7
View File
@@ -569,12 +569,17 @@ test {encoding-16.19 strict} {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
encoding convertfrom -profile strict utf-16 "\x41\x41\x41"
} -returnCodes 1 -result {unexpected byte sequence starting at index 2: '\x41'}
test {encoding-16.19 tcl8} {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
encoding convertfrom -profile strict utf-16 "\x41\x41\x41"
} -returnCodes 1 -result {unexpected byte sequence starting at index 2: '\x41'}
test encoding-16.19.tcl8 {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
encoding convertfrom -profile tcl8 utf-16 "\x41\x41\x41"
} -result \u4141\uFFFD
test encoding-16.20 {utf16ToUtfProc, bug [d19fe0a5b]} \
-constraints deprecated -body {
test encoding-16.19.strict {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
encoding convertfrom -profile strict utf-16 "\x41\x41\x41"
} -returnCodes 1 -result {unexpected byte sequence starting at index 2: '\x41'}
test encoding-16.20 {utf16ToUtfProc, bug [d19fe0a5b]} -body {
encoding convertfrom utf-16 "\xD8\xD8"
} -result \uD8D8
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xD8'}
test encoding-16.21.tcl8 {Utf32ToUtfProc, bug [d19fe0a5b]} -body {
encoding convertfrom -profile tcl8 utf-32 "\x00\x00\x00\x00\x41\x41"
} -result \x00\uFFFD
@@ -779,9 +784,12 @@ test encoding-24.3 {EscapeFreeProc on open channels} {stdio} {
list $count [viewable $line]
} [list 3 "乎乞也 (\\u4E4E\\u4E5E\\u4E5F)"]
test encoding-24.4 {Parse valid or invalid utf-8} {
string length [encoding convertfrom utf-8 "\xC0\x80"]
} 1
test {encoding-24.4 utf-8 invalid strict} {Parse invalid utf-8, strict} -body {
string length [encoding convertfrom -profile strict utf-8 "\xC0\x80"]
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test {encoding-24.4 utf-8 invalid tcl8} {UtfToUtfProc utf-8} {
encoding convertfrom -profile tcl8 utf-8 \xC0\x80
} \x00
test encoding-24.5 {Parse valid or invalid utf-8} {
string length [encoding convertfrom -profile tcl8 utf-8 "\xC0\x81"]
} 2
@@ -812,6 +820,9 @@ test encoding-24.13 {Parse invalid utf-8} -body {
test encoding-24.14 {Parse valid utf-8} {
expr {[encoding convertfrom utf-8 "\xC2\x80"] eq "\u80"}
} 1
test encoding-24.15.default {Parse invalid utf-8, default} -body {
encoding convertfrom -profile strict utf-8 "Z\xE0\x80"
} -returnCodes 1 -result "unexpected byte sequence starting at index 1: '\\xE0'"
test encoding-24.15.strict {Parse invalid utf-8, -profile strict} -body {
encoding convertfrom -profile strict utf-8 "Z\xE0\x80"
} -returnCodes 1 -result "unexpected byte sequence starting at index 1: '\\xE0'"
@@ -833,6 +844,9 @@ test encoding-24.19.1 {Parse valid or invalid utf-8} -body {
test encoding-24.19.2 {Parse valid or invalid utf-8} -body {
encoding convertto -profile strict utf-8 "ZX\uD800"
} -returnCodes 1 -match glob -result "unexpected character at index 2: 'U+00D800'"
test encoding-24.19.3 {Parse valid or invalid utf-8} -body {
encoding convertto utf-8 "ZX\uD800"
} -returnCodes 1 -match glob -result "unexpected character at index 2: 'U+00D800'"
test encoding-24.20 {Parse with -profile tcl8 but without providing encoding} -body {
encoding convertfrom -profile tcl8 "\x20"
} -result {wrong # args: should be "::tcl::encoding::convertfrom ?-profile profile? ?-failindex var? encoding data" or "::tcl::encoding::convertfrom data"} -returnCodes error
@@ -869,7 +883,7 @@ test encoding-24.30 {Parse noncharacter with -profile strict} -body {
test encoding-24.31 {Parse invalid utf-8 with -profile tcl8} -body {
encoding convertfrom -profile tcl8 utf-8 \xEF\xBF\xBF
} -result \uFFFF
test encoding-24.32 {Try to generate invalid utf-8} -body {
test encoding-24.33 {Try to generate invalid utf-8} -body {
encoding convertto utf-8 \uFFFF
} -result \xEF\xBF\xBF
test encoding-24.33 {Try to generate invalid utf-8} -body {
+1 -1
View File
@@ -10,7 +10,7 @@
# List of defined encoding profiles
set encProfiles {tcl8 strict replace}
set encDefaultProfile tcl8; # Should reflect the default from implementation
set encDefaultProfile strict; # Should reflect the default from implementation
# encValidStrings - Table of valid strings.
#
+317 -15
View File
@@ -1614,6 +1614,46 @@ test io-12.8 {ReadChars: multibyte chars split} {
close $f
scan [string index $in end] %c
} 160
apply [list {} {
set template {
test {io-12.9 @variant@} {ReadChars: multibyte chars split, default (strict)} -body {
set res {}
set f [open $path(test1) w]
fconfigure $f -translation binary
puts -nonewline $f [string repeat a 9]\xC2
close $f
set f [open $path(test1)]
fconfigure $f -encoding utf-8 @strict@ -buffersize 10
set status [catch {read $f} cres copts]
set in [dict get $copts -result]
lappend res $in
lappend res $status $cres
set status [catch {read $f} cres copts]
set in [dict get $copts -result]
lappend res $in
lappend res $status $cres
set res
} -cleanup {
catch {close $f}
} -match glob -result {{read aaaaaaaaa} 1 {error reading "file*":\
invalid or incomplete multibyte or wide character}\
{read {}} 1 {error reading "file*":\
invalid or incomplete multibyte or wide character}}
}
# if default encoding is not currently to strict
# foreach variant {default encodingstrict} strict {{} {-encodingstrict 1}}
foreach variant {{profile strict}} strict {{-profile strict}} {
set script [string map [
list @variant@ $variant @strict@ $strict] $template]
uplevel 1 $script
}
} [namespace current]]
test {io-12.9 profile tcl8} {ReadChars: multibyte chars split} -body {
set f [open $path(test1) w]
fconfigure $f -translation binary
@@ -1627,6 +1667,7 @@ test {io-12.9 profile tcl8} {ReadChars: multibyte chars split} -body {
} -cleanup {
catch {close $f}
} -result 194
test {io-12.10 strict} {ReadChars: multibyte chars split} -body {
set f [open $path(test1) w]
fconfigure $f -translation binary
@@ -1643,7 +1684,7 @@ test {io-12.10 strict} {ReadChars: multibyte chars split} -body {
invalid or incomplete multibyte or wide character}
test {io-12.10 tcl8} {ReadChars: multibyte chars split} -body {
test io-12.10.profiletcl8 {ReadChars: multibyte chars split} -body {
set f [open $path(test1) w]
fconfigure $f -translation binary
puts -nonewline $f [string repeat a 9]\xC2
@@ -5846,7 +5887,7 @@ test io-39.21 {Tcl_SetChannelOption, setting read mode independently} \
close $s2
set modes
} {auto crlf}
test io-39.22 {Tcl_SetChannelOption, invariance} -constraints {unix deprecated} -body {
test io-39.22 {Tcl_SetChannelOption, invariance} -constraints unix -body {
file delete $path(test1)
set f1 [open $path(test1) w+]
set l ""
@@ -5858,7 +5899,7 @@ test io-39.22 {Tcl_SetChannelOption, invariance} -constraints {unix deprecated}
close $f1
set l
} -result {{} O D}
test io-39.22a {Tcl_SetChannelOption, invariance} -constraints deprecated -body {
test io-39.22a {Tcl_SetChannelOption, invariance} -body {
file delete $path(test1)
set f1 [open $path(test1) w+]
set l [list]
@@ -5879,7 +5920,7 @@ test io-39.23 {Tcl_GetChannelOption, server socket is not readable or
set l
} {{} auto}
test io-39.24 {Tcl_SetChannelOption, server socket is not readable or
writable so we can't change -eofchar or -translation } {
writable so we can't change -eofchar or -translation } {
set l [list]
set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
fconfigure $sock -eofchar D -translation lf
@@ -9280,7 +9321,29 @@ test io-75.5 {invalid utf-8 encoding read is ignored (-profile tcl8)} -setup {
removeFile io-75.5
} -result 4181
test io-75.6 {invalid utf-8 encoding, gets is not ignored (-profile strict)} -setup {
test io-75.6.read {invalid utf-8 encoding, read is not ignored (-encodingstrict 1)} -setup {
set fn [makeFile {} io-75.6]
set f [open $fn w+]
fconfigure $f -encoding binary
# \x81 is invalid in utf-8
puts -nonewline $f A\x81
flush $f
seek $f 0
fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf \
-profile strict
} -body {
set status [catch {read $f} cres copts]
set d [dict get $copts -result read]
binary scan $d H* hd
lappend hd $status $cres
} -cleanup {
close $f
removeFile io-75.6
} -match glob -result {41 1 {error reading "file*":\
invalid or incomplete multibyte or wide character}}
test io-75.6.gets {invalid utf-8 encoding, gets is not ignored (-profile strict)} -setup {
set fn [makeFile {} io-75.6]
set f [open $fn w+]
fconfigure $f -encoding binary
@@ -9298,7 +9361,7 @@ test io-75.6 {invalid utf-8 encoding, gets is not ignored (-profile strict)} -se
} -match glob -returnCodes 1 -result {error reading "file*":\
invalid or incomplete multibyte or wide character}
test io-75.7 {
test io-75.7.gets {
invalid utf-8 encoding gets is not ignored (-profile strict)
} -setup {
set fn [makeFile {} io-75.7]
@@ -9318,12 +9381,67 @@ test io-75.7 {
} -match glob -result {1 {error reading "file*":\
invalid or incomplete multibyte or wide character}}
test io-75.8 {invalid utf-8 encoding eof handling (-profile strict)} -setup {
test io-75.7.read {invalid utf-8 encoding eof handling (-profile strict)} -setup {
set fn [makeFile {} io-75.7]
set f [open $fn w+]
fconfigure $f -encoding binary
# \xA1 is invalid in utf-8. -eofchar is not detected, because it comes later.
puts -nonewline $f A\xA1\x1A
flush $f
seek $f 0
fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
-translation lf -profile strict
} -body {
set status [catch {read $f} cres copts]
set d [dict get $copts -result read]
binary scan $d H* hd
lappend hd [eof $f]
lappend hd $status
lappend hd $cres
fconfigure $f -encoding iso8859-1
lappend hd [read $f];# We changed encoding, so now we can read the \xA1
close $f
set hd
} -cleanup {
removeFile io-75.7
} -match glob -result {41 0 1 {error reading "file*":\
invalid or incomplete multibyte or wide character} ¡}
test io-75.7.read {invalid utf-8 encoding eof handling (-profile strict)} -setup {
set fn [makeFile {} io-75.7]
set f [open $fn w+]
fconfigure $f -encoding binary
# \xA1 is invalid in utf-8. -eofchar is not detected, because it comes later.
puts -nonewline $f A\xA1\x1A
flush $f
seek $f 0
fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
-translation lf -profile strict
} -body {
set status [catch {read $f} cres copts]
set d [dict get $copts -result read]
binary scan $d H* hd
lappend hd [eof $f]
lappend hd $status
lappend hd $cres
fconfigure $f -encoding iso8859-1
lappend hd [read $f];# We changed encoding, so now we can read the \xA1
close $f
set hd
} -cleanup {
removeFile io-75.7
} -match glob -result {41 0 1 {error reading "file*":\
invalid or incomplete multibyte or wide character} ¡}
test io-75.8.incomplete {
incomplete uft-8 char after eof char is not an error (-profile strict)
} -setup {
set hd {}
set fn [makeFile {} io-75.8]
set f [open $fn w+]
fconfigure $f -encoding binary
# \x81 is invalid in utf-8, but since \x1A comes first, -eofchar takes
# precedence.
# \x81 is invalid in utf-8, but since the eof character \x1A comes first,
# -eofchar takes precedence.
puts -nonewline $f A\x1A\x81
flush $f
seek $f 0
@@ -9333,6 +9451,7 @@ test io-75.8 {invalid utf-8 encoding eof handling (-profile strict)} -setup {
set d [read $f]
binary scan $d H* hd
lappend hd [eof $f]
# there should be no error on additional reads
lappend hd [read $f]
close $f
set hd
@@ -9340,7 +9459,39 @@ test io-75.8 {invalid utf-8 encoding eof handling (-profile strict)} -setup {
removeFile io-75.8
} -result {41 1 {}}
test io-75.8.eoflater {invalid utf-8 encoding eof handling (-profile strict)} -setup {
test {io-75.8 {invalid after eof}} {
invalid utf-8 after eof char is not an error (-profile strict)
} -setup {
set res {}
set fn [makeFile {} io-75.8]
set f [open $fn w+]
fconfigure $f -encoding binary
# \xc0\x80 is invalid utf-8 data, but because the eof character \x1A
# appears first, it's not an error.
puts -nonewline $f A\x1a\xc0\x80
flush $f
seek $f 0
fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
-translation lf -profile strict
} -body {
set d [read $f]
foreach char [split $d {}] {
lappend res [format %x [scan $char %c]]
}
lappend res [eof $f]
# there should be no error on additional reads
lappend res [read $f]
close $f
set res
} -cleanup {
removeFile io-75.8
} -result {41 1 {}}
test {io-75.8 {invalid before eof}} {
invalid utf-8 encoding eof handling (-profile strict)
} -setup {
set fn [makeFile {} io-75.8]
set f [open $fn w+]
# This also configures the channel encoding profile as strict.
@@ -9386,6 +9537,7 @@ test io-strict-multibyte-eof {
} -match glob -result {1 {error reading "*":\
invalid or incomplete multibyte or wide character}}
test io-75.9 {unrepresentable character write passes and is replaced by ?} -setup {
set fn [makeFile {} io-75.9]
set f [open $fn w+]
@@ -9401,7 +9553,42 @@ test io-75.9 {unrepresentable character write passes and is replaced by ?} -setu
} -match glob -result [list {A} {error writing "*":\
invalid or incomplete multibyte or wide character}]
test io-75.10 {
apply [list {} {
set template {
test {io-75.10 ${mode}} {
incomplete multibyte encoding read is an error
} -setup {
set res {}
set fn [makeFile {} io-75.10]
set f [open $fn w+]
fconfigure $f -encoding binary
puts -nonewline $f A\xC0
flush $f
seek $f 0
fconfigure $f -encoding utf-8 -buffering none {*}${option}
} -body {
set status [catch {read $f} cres copts]
set d [dict get $copts -result read]
close $f
binary scan $d H* hd
lappend res $hd
lappend res $status
lappend res $cres
return $res
} -cleanup {
removeFile io-75.10
} -match glob -result {41 1 {error reading "file*":\
invalid or incomplete multibyte or wide character}}
}
# the default encoding mode is not currently strict
#foreach mode {default strict} option {{} {-encodingstrict 1}}
foreach mode {{profile strict}} option {{-profile strict}} {
set test [string map [
list {${mode}} [list $mode] {${option}} [list $option]] $template]
uplevel $test
}
} [namespace current]]
test {io-75.10 {profile tcl8}} {
incomplete multibyte encoding read is not ignored because "binary" sets
profile to strict
} -setup {
@@ -9455,9 +9642,45 @@ test io-75.11 {shiftjis encoding error read results in raw bytes} -setup {
} -match glob -result {41 1 {error reading "file*":\
invalid or incomplete multibyte or wide character}}
test io-75.12 {
invalid utf-8 encoding read is not ignored because setting the encoding to
"binary" also set the profile to strict
apply [list {} {
set template {
test {io-75.12 ${mode}} {invalid utf-8 encoding read returns an error} -setup {
set res {}
set fn [makeFile {} io-75.12]
set f [open $fn w+]
fconfigure $f -encoding binary
puts -nonewline $f A\x81
flush $f
seek $f 0
fconfigure $f -encoding utf-8 -buffering none -eofchar {} \
-translation lf {*}${option}
} -body {
set status [catch {read $f} cres copts]
set d [dict get $copts -result read]
close $f
binary scan $d H* hd
lappend res $hd $status $cres
return $res
} -cleanup {
removeFile io-75.12
} -match glob -result {41 1 {error reading "file*":\
invalid or incomplete multibyte or wide character}}
}
# the default encoding mod is not currently strict
#foreach mode {default strict} option {{} {-encodingstrict 1}}
foreach mode {{profile strict}} option {{-profile strict}} {
set test [string map [
list {${mode}} [list $mode] {${option}} [list $option]] $template]
uplevel $test
}
} [namespace current]]
test {io-75.12 {profile tcl8}} {
invalid utf-8 encoding read, is not ignored because setting the encoding to
"binary" also sets the profile to strict
} -setup {
set res {}
set fn [makeFile {} io-75.12]
@@ -9466,7 +9689,8 @@ test io-75.12 {
puts -nonewline $f A\x81
flush $f
seek $f 0
fconfigure $f -encoding utf-8 -buffering none -eofchar {} -translation lf
fconfigure $f -encoding utf-8 -buffering none -eofchar {} \
-translation lf
} -body {
catch {read $f} errmsg
lappend res $errmsg
@@ -9483,6 +9707,29 @@ test io-75.12 {
} -match glob -result {{error reading "file*":\
invalid or incomplete multibyte or wide character} 4181}
test io-75.13 {
In blocking mode [read] produces an error and leaves the data succesfully
read so far in the return options dictionary.
} -setup {
set fn [makeFile {} io-75.13]
set f [open $fn w+]
fconfigure $f -encoding binary
# \x81 is invalid in utf-8
puts -nonewline $f A\x81
flush $f
seek $f 0
fconfigure $f -encoding utf-8 -eofchar "" -translation lf -profile strict
} -body {
set status [catch {read $f} cres copts]
set d [dict get $copts -result read]
binary scan $d H* hd
lappend hd $status
lappend hd $cres
} -cleanup {
close $f
removeFile io-75.13
} -match glob -result {41 1 {error reading "file*":\
invalid or incomplete multibyte or wide character}}
test io-75.13.nonblocking {
In nonblocking mode when there is an encoding error the data that has been
successfully read so far is returned first and then the error is returned
on the next call to [read].
@@ -9564,6 +9811,61 @@ test io-75.15 {
} -match glob -result {hello AB 1 {error reading "*": invalid or incomplete multibyte or wide character}\
1 {error reading "*": invalid or incomplete multibyte or wide character} 43 44 c0 40 EF GHI}
test io-75.14 {invalid utf-8 encoding [gets] coninues in non-strict mode after error} -setup {
set res {}
set fn [makeFile {} io-75.14]
set f [open $fn w+]
fconfigure $f -encoding binary
# \xc0 is invalid in utf-8
puts -nonewline $f a\nb\xc0\nc\n
flush $f
seek $f 0
fconfigure $f -encoding utf-8 -buffering none -eofchar {} -translation lf -profile strict
} -body {
lappend res [gets $f]
set status [catch {gets $f} cres copts]
lappend res $status $cres
chan configure $f -profile tcl8
lappend res [gets $f]
lappend res [gets $f]
close $f
return $res
} -cleanup {
removeFile io-75.14
} -match glob -result {a 1 {error reading "file*":\
invalid or incomplete multibyte or wide character} bÀ c}
test io-75.15 {invalid utf-8 encoding strict gets should not hang} -setup {
set res {}
set fn [makeFile {} io-75.15]
set chan [open $fn w+]
fconfigure $chan -encoding binary
# This is not valid UTF-8
puts $chan hello\nAB\xc0\x40CD\nEFG
close $chan
} -body {
#Now try to read it with [gets]
set chan [open $fn]
fconfigure $chan -encoding utf-8 -profile strict
lappend res [gets $chan]
set status [catch {gets $chan} cres copts]
lappend res $status $cres
set status [catch {gets $chan} cres copts]
lappend res $status $cres
lappend res [dict get $copts -result]
chan configure $chan -encoding binary
foreach char [split [read $chan 2] {}] {
lappend res [format %x [scan $char %c]]
}
return $res
} -cleanup {
close $chan
removeFile io-75.15
} -match glob -result {hello 1 {error reading "file*":\
invalid or incomplete multibyte or wide character} 1 {error reading "file*":\
invalid or incomplete multibyte or wide character} {read AB} 41 42}
# ### ### ### ######### ######### #########
+1 -1
View File
@@ -1397,7 +1397,7 @@ test iocmd-25.1 {chan configure, cgetall, standard options} -match glob -body {
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -profile * -translation {auto *}}}
test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body {
set res {}
proc foo args {oninit cget cgetall; onfinal; track; return ""}
proc foo args {oninit cget cgetall; onfinal; track; return {}}
set c [chan create {r w} foo]
note [fconfigure $c]
close $c
-1
View File
@@ -6,7 +6,6 @@ if {[package provide tcltests] ne {}} return
package require tcltest 2.5
namespace import ::tcltest::*
testConstraint exec [llength [info commands exec]]
testConstraint deprecated [expr {![tcl::build-info no-deprecate]}]
testConstraint debug [tcl::build-info debug]
testConstraint purify [tcl::build-info purify]
testConstraint debugpurify [
+2 -2
View File
@@ -95,11 +95,11 @@ test utf-1.15 {Tcl_UniCharToUtf: surrogate pairs from concat} {
test utf-1.16 {Tcl_UniCharToUtf: \xC0 + \x80} testbytestring {
set lo [testbytestring \x80]
string length [testbytestring \xC0]$lo
} 2
} 1
test utf-1.17 {Tcl_UniCharToUtf: \xC0 + \x80} testbytestring {
set hi [testbytestring \xC0]
string length $hi[testbytestring \x80]
} 2
} 1
test utf-1.18 {Tcl_UniCharToUtf: surrogate pairs from concat} {
string cat \uD83D \uDE02
} \uD83D\uDE02
+2 -14
View File
@@ -212,7 +212,6 @@ static const unsigned short pageMap\[\] = {"
puts $f $line
set lastpage [expr {[lindex $line end] >> $shift}]
puts stdout "lastpage: $lastpage"
puts $f "#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6"
set line " ,"
}
append line [lindex $pMap $i]
@@ -225,7 +224,6 @@ static const unsigned short pageMap\[\] = {"
}
}
puts $f $line
puts $f "#endif /* TCL_UTF_MAX > 3 */"
puts $f "};
/*
@@ -242,7 +240,6 @@ static const unsigned char groupMap\[\] = {"
set lastj [expr {[llength $page] - 1}]
if {$i == ($lastpage + 1)} {
puts $f [string trimright $line " \t,"]
puts $f "#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6"
set line " ,"
}
for {set j 0} {$j <= $lastj} {incr j} {
@@ -257,7 +254,6 @@ static const unsigned char groupMap\[\] = {"
}
}
puts $f $line
puts $f "#endif /* TCL_UTF_MAX > 3 */"
puts $f "};
/*
@@ -342,11 +338,7 @@ static const int groups\[\] = {"
puts $f $line
puts -nonewline $f "};
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= [format 0x%X $next])
#else
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1F0000) != 0)
#endif
#define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= [format 0x%X $next])
/*
* The following constants are used to determine the category of a
@@ -401,11 +393,7 @@ enum {
* Unicode character tables.
*/
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
# define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0x1FFFFF) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
#else
# define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0xFFFF) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
#endif
#define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0x1FFFFF) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
"
close $f
-5
View File
@@ -136,11 +136,6 @@ STUB_LIB_FILE = ${TCL_STUB_LIB_FILE}
TCL_STUB_LIB_FLAG = @TCL_STUB_LIB_FLAG@
#TCL_STUB_LIB_FLAG = -ltclstub
# To compile without backward compatibility and deprecated code uncomment the
# following
NO_DEPRECATED_FLAGS =
#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED
# Some versions of make, like SGI's, use the following variable to determine
# which shell to use for executing commands:
SHELL = @MAKEFILE_SHELL@
+3 -39
View File
@@ -17,7 +17,7 @@ TCL_VERSION= @TCL_VERSION@
CFLAGS_DEBUG = @CFLAGS_DEBUG@
CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@
CFLAGS = @CFLAGS_DEFAULT@ @CFLAGS@ -DTCL_NO_DEPRECATED=1 -Wall -Wextra -Wc++-compat -Wconversion -Werror
CFLAGS = @CFLAGS_DEFAULT@ @CFLAGS@ -Wall -Wextra -Wc++-compat -Wconversion -Werror
LDFLAGS_DEBUG = @LDFLAGS_DEBUG@
LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@
LDFLAGS = @LDFLAGS_DEFAULT@ @LDFLAGS@
@@ -27,13 +27,13 @@ CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \
all: embtest tcl9pkga${SHLIB_SUFFIX} tcl9pkgb${SHLIB_SUFFIX} tcl9pkgc${SHLIB_SUFFIX} \
tcl9pkgd${SHLIB_SUFFIX} tcl9pkge${SHLIB_SUFFIX} tcl9pkgt${SHLIB_SUFFIX} tcl9pkgua${SHLIB_SUFFIX} \
tcl9pkgooa${SHLIB_SUFFIX} pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgt${SHLIB_SUFFIX}
tcl9pkgooa${SHLIB_SUFFIX}
@if test -n "$(DLTEST_SUFFIX)"; then $(MAKE) dltest_suffix; fi
@touch ../dltest.marker
dltest_suffix: tcl9pkga${DLTEST_SUFFIX} tcl9pkgb${DLTEST_SUFFIX} tcl9pkgc${DLTEST_SUFFIX} \
tcl9pkgd${DLTEST_SUFFIX} tcl9pkge${DLTEST_SUFFIX} tcl9pkgt${DLTEST_SUFFIX} tcl9pkgua${DLTEST_SUFFIX} \
tcl9pkgooa${DLTEST_SUFFIX} pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgt${DLTEST_SUFFIX}
tcl9pkgooa${DLTEST_SUFFIX}
@touch ../dltest.marker
embtest.o: $(SRC_DIR)/embtest.c
@@ -54,18 +54,6 @@ pkgc.o: $(SRC_DIR)/pkgc.c
pkgt.o: $(SRC_DIR)/pkgt.c
$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgt.c
tcl8pkga.o: $(SRC_DIR)/pkga.c
$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkga.c
tcl8pkgb.o: $(SRC_DIR)/pkgb.c
$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgb.c
tcl8pkgc.o: $(SRC_DIR)/pkgc.c
$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgc.c
tcl8pkgt.o: $(SRC_DIR)/pkgt.c
$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgt.c
pkgd.o: $(SRC_DIR)/pkgd.c
$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgd.c
@@ -96,18 +84,6 @@ tcl9pkgc${SHLIB_SUFFIX}: pkgc.o
tcl9pkgt${SHLIB_SUFFIX}: pkgt.o
${SHLIB_LD} -o $@ pkgt.o ${SHLIB_LD_LIBS}
pkga${SHLIB_SUFFIX}: tcl8pkga.o
${SHLIB_LD} -o $@ tcl8pkga.o ${SHLIB_LD_LIBS}
pkgb${SHLIB_SUFFIX}: tcl8pkgb.o
${SHLIB_LD} -o $@ tcl8pkgb.o ${SHLIB_LD_LIBS}
pkgc${SHLIB_SUFFIX}: tcl8pkgc.o
${SHLIB_LD} -o $@ tcl8pkgc.o ${SHLIB_LD_LIBS}
pkgt${SHLIB_SUFFIX}: tcl8pkgt.o
${SHLIB_LD} -o $@ tcl8pkgt.o ${SHLIB_LD_LIBS}
tcl9pkgd${SHLIB_SUFFIX}: pkgd.o
${SHLIB_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS}
@@ -135,18 +111,6 @@ tcl9pkgc${DLTEST_SUFFIX}: pkgc.o
tcl9pkgt${DLTEST_SUFFIX}: pkgt.o
${DLTEST_LD} -o $@ pkgt.o ${SHLIB_LD_LIBS}
pkga${DLTEST_SUFFIX}: tcl8pkga.o
${DLTEST_LD} -o $@ tcl8pkga.o ${SHLIB_LD_LIBS}
pkgb${DLTEST_SUFFIX}: tcl8pkgb.o
${DLTEST_LD} -o $@ tcl8pkgb.o ${SHLIB_LD_LIBS}
pkgc${DLTEST_SUFFIX}: tcl8pkgc.o
${DLTEST_LD} -o $@ tcl8pkgc.o ${SHLIB_LD_LIBS}
pkgt${DLTEST_SUFFIX}: tcl8pkgt.o
${DLTEST_LD} -o $@ tcl8pkgt.o ${SHLIB_LD_LIBS}
tcl9pkgd${DLTEST_SUFFIX}: pkgd.o
${DLTEST_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS}
+1 -10
View File
@@ -13,15 +13,6 @@
*/
#include "tcl.h"
#if TCL_MAJOR_VERSION < 9
# if defined(USE_TCL_STUBS)
# error "Don't build with USE_TCL_STUBS!"
# endif
# if TCL_MINOR_VERSION < 7
# define Tcl_LibraryInitProc Tcl_PackageInitProc
# define Tcl_StaticLibrary Tcl_StaticPackage
# endif
#endif
#ifdef TCL_TEST
extern Tcl_LibraryInitProc Tcltest_Init;
@@ -86,7 +77,7 @@ main(
#ifdef TCL_LOCAL_MAIN_HOOK
TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE))
#elif !defined(_WIN32) || defined(UNICODE)
/* New in Tcl 8.7. This doesn't work on Windows without UNICODE */
TclZipfs_AppHook(&argc, &argv);
#endif
+1 -30
View File
@@ -84,11 +84,6 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@
#CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DMP_FIXED_CUTOFFS -D__USE_MINGW_ANSI_STDIO=0 -DMP_NO_STDINT
# To compile without backward compatibility and deprecated code uncomment the
# following
NO_DEPRECATED_FLAGS =
#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED
# To enable compilation debugging reverse the comment characters on one of the
# following lines.
COMPILE_DEBUG_FLAGS =
@@ -150,10 +145,8 @@ TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@
TCL_DLL_FILE = @TCL_DLL_FILE@
TCL_LIB_FILE = @TCL_LIB_FILE@
DDE_DLL_FILE = tcl9dde$(DDEVER)${DLLSUFFIX}
DDE_DLL_FILE8 = tcldde$(DDEVER)${DLLSUFFIX}
DDE_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX}
REG_DLL_FILE = tcl9registry$(REGVER)${DLLSUFFIX}
REG_DLL_FILE8 = tclregistry$(REGVER)${DLLSUFFIX}
REG_LIB_FILE = @LIBPREFIX@tclregistry$(REGVER)${DLLSUFFIX}${LIBSUFFIX}
TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX}
TEST_EXE_FILE = tcltest${EXESUFFIX}
@@ -519,7 +512,7 @@ tcltest: binaries $(TEST_EXE_FILE) $(TEST_DLL_FILE) $(CAT32) tcltest.cmd
binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions ${TCL_ZIP_FILE} $(TCLSH)
winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} ${DDE_DLL_FILE8} ${REG_DLL_FILE8}
winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE}
libraries:
@@ -593,14 +586,6 @@ ${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS}
@MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
$(COPY) tclsh.exe.manifest ${REG_DLL_FILE}.manifest
${DDE_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinDde.$(OBJEXT)
@MAKE_DLL@ tcl8WinDde.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
$(COPY) tclsh.exe.manifest ${DDE_DLL_FILE8}.manifest
${REG_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinReg.$(OBJEXT)
@MAKE_DLL@ -DTCL_MAJOR_VERSION=8 tcl8WinReg.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
$(COPY) tclsh.exe.manifest ${REG_DLL_FILE8}.manifest
${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS}
@$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE}
@MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
@@ -653,15 +638,9 @@ tclWinPipe.${OBJEXT}: tclWinPipe.c
tclWinReg.${OBJEXT}: tclWinReg.c
$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
tcl8WinReg.${OBJEXT}: tclWinReg.c
$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
tclWinDde.${OBJEXT}: tclWinDde.c
$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
tcl8WinDde.${OBJEXT}: tclWinDde.c
$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
tclAppInit.${OBJEXT}: tclAppInit.c
$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)
@@ -860,10 +839,6 @@ install-binaries: binaries
$(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
"$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
fi
@if [ -f $(DDE_DLL_FILE8) ]; then \
echo Installing $(DDE_DLL_FILE8); \
$(COPY) $(DDE_DLL_FILE8) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
fi
@if [ -f $(DDE_LIB_FILE) ]; then \
echo Installing $(DDE_LIB_FILE); \
$(COPY) $(DDE_LIB_FILE) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
@@ -874,10 +849,6 @@ install-binaries: binaries
$(COPY) $(ROOT_DIR)/library/registry/pkgIndex.tcl \
"$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \
fi
@if [ -f $(REG_DLL_FILE8) ]; then \
echo Installing $(REG_DLL_FILE8); \
$(COPY) $(REG_DLL_FILE8) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \
fi
@if [ -f $(REG_LIB_FILE) ]; then \
echo Installing $(REG_LIB_FILE); \
$(COPY) $(REG_LIB_FILE) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \
+1 -73
View File
@@ -816,7 +816,6 @@ DOTSEPARATED=$(DOTSEPARATED:b=.)
# configuration (ignored for Tcl itself)
# _USE_64BIT_TIME_T - forces a build using 64-bit time_t for 32-bit build
# (CRT library should support this, not needed for Tcl 9.x)
# TCL_UTF_MAX=3 - forces a build using UTF-16 internally (not recommended).
# Further, LINKERFLAGS are modified based on above.
# Default values for all the above
@@ -860,9 +859,6 @@ MSVCRT = 0
!if [nmakehlp -f $(OPTS) "msvcrt"]
!message *** Doing msvcrt
!else
!if $(TCL_MAJOR_VERSION) == 8 && $(TCL_MINOR_VERSION) < 7 && $(STATIC_BUILD)
MSVCRT = 0
!endif
!endif
!endif # [nmakehlp -f $(OPTS) "nomsvcrt"]
@@ -877,23 +873,6 @@ TCL_THREADS = 0
USE_THREAD_ALLOC= 0
!endif
!if [nmakehlp -f $(OPTS) "tcl8"]
!message *** Build for Tcl8
TCL_BUILD_FOR = 8
!endif
!if $(TCL_MAJOR_VERSION) == 8
!if [nmakehlp -f $(OPTS) "time64bit"]
!message *** Force 64-bit time_t
_USE_64BIT_TIME_T = 1
!endif
!endif
!if [nmakehlp -f $(OPTS) "utf16"]
!message *** Force UTF-16 internally
TCL_UTF_MAX = 3
!endif
# Yes, it's weird that the "symbols" option controls DEBUG and
# the "pdbs" option controls SYMBOLS. That's historical.
!if [nmakehlp -f $(OPTS) "symbols"]
@@ -1010,18 +989,13 @@ TCL_COMPILE_DEBUG = 0
# 9. Parse the CHECKS macro to configure additional compiler checks
# The following macros are set by this section:
# WARNINGS - compiler switches that control the warnings level
# TCL_NO_DEPRECATED - 1 -> disable support for deprecated functions
# 0 -> enable deprecated functions
# Defaults - Permit deprecated functions and warning level 3
TCL_NO_DEPRECATED = 0
WARNINGS = -W3
!if "$(CHECKS)" != "" && ![nmakehlp -f "$(CHECKS)" "none"]
!if [nmakehlp -f $(CHECKS) "nodep"]
!message *** Doing nodep check
TCL_NO_DEPRECATED = 1
!endif
!if [nmakehlp -f $(CHECKS) "fullwarn"]
@@ -1151,11 +1125,7 @@ TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
TCLLIB = $(OUT_DIR)\$(TCLLIBNAME)
TCLSCRIPTZIP = $(OUT_DIR)\$(TCLSCRIPTZIPNAME)
!if $(TCL_MAJOR_VERSION) == 8
TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
!else
TCLSTUBLIBNAME = $(STUBPREFIX).lib
!endif
TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME)
TCL_INCLUDES = -I"$(WIN_DIR)" -I"$(GENERICDIR)"
@@ -1171,11 +1141,7 @@ TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe
TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX:t=).exe
!endif
!if $(TCL_MAJOR_VERSION) == 8
TCLSTUBLIB = $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib
!else
TCLSTUBLIB = $(_TCLDIR)\lib\tclstub.lib
!endif
TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib
# When building extensions, may be linking against Tcl that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
@@ -1195,11 +1161,7 @@ TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:t=).exe
!if !exist($(TCLSH))
TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX:t=).exe
!endif
!if $(TCL_MAJOR_VERSION) == 8
TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib
!else
TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub.lib
!endif
TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib
# When building extensions, may be linking against Tcl that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
@@ -1215,11 +1177,7 @@ TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
!endif # TCLINSTALL
!if !$(STATIC_BUILD) && "$(TCL_BUILD_FOR)" == "8"
tcllibs = "$(TCLSTUBLIB)"
!else
tcllibs = "$(TCLSTUBLIB)" "$(TCLIMPLIB)"
!endif
!endif # $(DOING_TCL)
@@ -1239,13 +1197,8 @@ WISHNAMEPREFIX = wish
WISHNAME = $(WISHNAMEPREFIX)$(TK_VERSION)$(SUFX).exe
TKLIBNAME8 = tk$(TK_VERSION)$(SUFX).$(EXT)
TKLIBNAME9 = tcl9tk$(TK_VERSION)$(SUFX).$(EXT)
!if $(TCL_MAJOR_VERSION) == 8 || "$(TCL_BUILD_FOR)" == "8"
TKLIBNAME = tk$(TK_VERSION)$(SUFX).$(EXT)
TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX).lib
!else
TKLIBNAME = tcl9tk$(TK_VERSION)$(SUFX).$(EXT)
TKIMPLIBNAME = tcl9tk$(TK_VERSION)$(SUFX).lib
!endif
TKSTUBLIBNAME = tkstub$(TK_VERSION).lib
!if $(DOING_TK)
@@ -1296,18 +1249,10 @@ tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)"
PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
PRJLIBNAME8 = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
PRJLIBNAME9 = tcl9$(PROJECT)$(VERSION)$(SUFX).$(EXT)
!if $(TCL_MAJOR_VERSION) == 8 || "$(TCL_BUILD_FOR)" == "8"
PRJLIBNAME = $(PRJLIBNAME8)
!else
PRJLIBNAME = $(PRJLIBNAME9)
!endif
PRJLIB = $(OUT_DIR)\$(PRJLIBNAME)
!if $(TCL_MAJOR_VERSION) == 8
PRJSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
!else
PRJSTUBLIBNAME = $(STUBPREFIX).lib
!endif
PRJSTUBLIB = $(OUT_DIR)\$(PRJSTUBLIBNAME)
# If extension parent makefile has not defined a resource definition file,
@@ -1412,9 +1357,7 @@ OPTDEFINES = $(OPTDEFINES) /DTCL_WITH_EXTERNAL_TOMMATH
OPTDEFINES = $(OPTDEFINES) /DMP_64BIT
!endif
!endif
!if $(TCL_NO_DEPRECATED)
OPTDEFINES = $(OPTDEFINES) /DTCL_NO_DEPRECATED
!endif
OPTDEFINES = $(OPTDEFINES)
!if $(USE_STUBS)
# Note we do not define USE_TCL_STUBS even when building tk since some
@@ -1443,21 +1386,6 @@ OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_DO64BIT
OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64=1
!endif
!if $(TCL_MAJOR_VERSION) == 8
!if "$(_USE_64BIT_TIME_T)" == "1"
OPTDEFINES = $(OPTDEFINES) /D_USE_64BIT_TIME_T=1
!endif
# _ATL_XP_TARGETING - Newer SDK's need this to build for XP
COMPILERFLAGS = /D_ATL_XP_TARGETING
!endif
!if "$(TCL_UTF_MAX)" == "3"
OPTDEFINES = $(OPTDEFINES) /DTCL_UTF_MAX=3
!endif
!if "$(TCL_BUILD_FOR)" == "8"
OPTDEFINES = $(OPTDEFINES) /DTCL_MAJOR_VERSION=8
!endif
# Like the TEA system only set this non empty for non-Tk extensions
# Note: some extensions use PACKAGE_NAME and others use PACKAGE_TCLNAME
# so we pass both
+1 -10
View File
@@ -15,15 +15,6 @@
*/
#include "tcl.h"
#if TCL_MAJOR_VERSION < 9
# if defined(USE_TCL_STUBS)
# error "Don't build with USE_TCL_STUBS!"
# endif
# if TCL_MINOR_VERSION < 7
# define Tcl_LibraryInitProc Tcl_PackageInitProc
# define Tcl_StaticLibrary Tcl_StaticPackage
# endif
#endif
#ifdef TCL_TEST
extern Tcl_LibraryInitProc Tcltest_Init;
@@ -136,7 +127,7 @@ _tmain(
#ifdef TCL_LOCAL_MAIN_HOOK
TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE))
#elif (!defined(_WIN32) || defined(UNICODE))
/* New in Tcl 8.7. This doesn't work on Windows without UNICODE */
TclZipfs_AppHook(&argc, &argv);
#endif
-33
View File
@@ -117,28 +117,11 @@ static int DdeObjCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7)
# if TCL_UTF_MAX > 3
# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
# else
# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
# endif
#define Tcl_Size int
#define TCL_INDEX_NONE -1
#endif
#ifdef __cplusplus
extern "C" {
#endif
DLLEXPORT int Dde_Init(Tcl_Interp *interp);
DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp);
#if TCL_MAJOR_VERSION < 9
/* With those additional entries, "load dde14.dll" works without 3th argument */
DLLEXPORT int Tcldde_Init(Tcl_Interp *interp);
DLLEXPORT int Tcldde_SafeInit(Tcl_Interp *interp);
#endif
#ifdef __cplusplus
}
#endif
@@ -171,14 +154,6 @@ Dde_Init(
Tcl_CreateExitHandler(DdeExitProc, NULL);
return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL);
}
#if TCL_MAJOR_VERSION < 9
int
Tcldde_Init(
Tcl_Interp *interp)
{
return Dde_Init(interp);
}
#endif
/*
*----------------------------------------------------------------------
@@ -206,14 +181,6 @@ Dde_SafeInit(
}
return result;
}
#if TCL_MAJOR_VERSION < 9
int
Tcldde_SafeInit(
Tcl_Interp *interp)
{
return Dde_SafeInit(interp);
}
#endif
/*
*----------------------------------------------------------------------
-34
View File
@@ -124,28 +124,11 @@ static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
Tcl_Obj *typeObj, REGSAM mode);
#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7)
# if TCL_UTF_MAX > 3
# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
# else
# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
# endif
#define Tcl_Size int
#define TCL_INDEX_NONE -1
#endif
#ifdef __cplusplus
extern "C" {
#endif
DLLEXPORT int Registry_Init(Tcl_Interp *interp);
DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags);
#if TCL_MAJOR_VERSION < 9
/* With those additional entries, "load registry13.dll" works without 3th argument */
DLLEXPORT int Tclregistry_Init(Tcl_Interp *interp);
DLLEXPORT int Tclregistry_Unload(Tcl_Interp *interp, int flags);
#endif
#ifdef __cplusplus
}
#endif
@@ -181,14 +164,6 @@ Registry_Init(
Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
return Tcl_PkgProvideEx(interp, "registry", "1.3.7", NULL);
}
#if TCL_MAJOR_VERSION < 9
int
Tclregistry_Init(
Tcl_Interp *interp)
{
return Registry_Init(interp);
}
#endif
/*
*----------------------------------------------------------------------
@@ -235,15 +210,6 @@ Registry_Unload(
return TCL_OK;
}
#if TCL_MAJOR_VERSION < 9
int
Tclregistry_Unload(
Tcl_Interp *interp,
int flags)
{
return Registry_Unload(interp, flags);
}
#endif
/*
*----------------------------------------------------------------------