summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/zipfs.n2
-rw-r--r--generic/tclBasic.c2
-rw-r--r--generic/tclEncoding.c164
-rw-r--r--generic/tclIORChan.c20
-rw-r--r--generic/tclIORTrans.c17
-rw-r--r--generic/tclOO.c4
-rw-r--r--generic/tclOODefineCmds.c2
-rw-r--r--generic/tclOOInt.h2
-rw-r--r--generic/tclOOProp.c14
-rw-r--r--win/Makefile.in2
-rwxr-xr-xwin/configure6
-rw-r--r--win/configure.ac4
-rw-r--r--win/tcl.m42
-rw-r--r--win/tclWinReg.c9
14 files changed, 189 insertions, 61 deletions
diff --git a/doc/zipfs.n b/doc/zipfs.n
index f4e2949..2cf00aa 100644
--- a/doc/zipfs.n
+++ b/doc/zipfs.n
@@ -131,7 +131,7 @@ The command returns the normalized mount point path.
If not under the zipfs file system root, \fImountpoint\fR is normalized with
respect to it. For example, a mount point passed as either \fBmt\fR or \fB/mt\fR
would be normalized to \fB//zipfs:/mt\fR (given that \fBzipfs root\fR
-returns
+returns
.QW //zipfs:/ ).
An error is raised if the mount point includes a drive or UNC volume.
.PP
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 1878d27..a979ab9 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -463,7 +463,7 @@ static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = {
{"process", "status"},
{"process", "purge"},
{"process", "autopurge"},
- /*
+ /*
* [zipfs] perhaps has some safe commands. But like file make it inaccessible
* until they are analyzed to be safe.
*/
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 64fb1b6..ae73c77 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -2424,7 +2424,11 @@ UtfToUtfProc(
const char *src, /* Source string in UTF-8. */
int srcLen, /* Source string length in bytes. */
int flags, /* TCL_ENCODING_* conversion control flags. */
- TCL_UNUSED(Tcl_EncodingState *),
+ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
+ * information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
char *dst, /* Output buffer in which converted string is
* stored. */
int dstLen, /* The maximum length of output buffer in
@@ -2447,6 +2451,10 @@ UtfToUtfProc(
int ch;
int profile;
+ if (flags & TCL_ENCODING_START) {
+ /* *statePtr will hold high surrogate in a split surrogate pair */
+ *statePtr = 0;
+ }
result = TCL_OK;
srcStart = src;
@@ -2463,6 +2471,42 @@ UtfToUtfProc(
flags |= PTR2INT(clientData);
dstEnd = dst + dstLen - ((flags & ENCODING_UTF) ? TCL_UTF_MAX : 6);
+ /*
+ * Macro to output an isolated high surrogate when it is not followed
+ * by a low surrogate. NOT to be called for strict profile since
+ * that should raise an error.
+ */
+#define OUTPUT_ISOLATEDSURROGATE \
+ do { \
+ Tcl_UniChar high; \
+ if (PROFILE_REPLACE(profile)) { \
+ high = UNICODE_REPLACE_CHAR; \
+ } else { \
+ high = (Tcl_UniChar)(ptrdiff_t) *statePtr; \
+ } \
+ assert(!(flags & ENCODING_UTF)); /* Must be CESU-8 */ \
+ assert(HIGH_SURROGATE(high)); \
+ assert(!PROFILE_STRICT(profile)); \
+ dst += Tcl_UniCharToUtf(high, dst); \
+ *statePtr = 0; /* Reset state */ \
+ } while (0)
+
+ /*
+ * Macro to check for isolated surrogate and either break with
+ * an error if profile is strict, or output an appropriate
+ * character for replace and tcl8 profiles and continue.
+ */
+#define CHECK_ISOLATEDSURROGATE \
+ if (*statePtr) { \
+ if (PROFILE_STRICT(profile)) { \
+ result = TCL_CONVERT_SYNTAX; \
+ break; \
+ } \
+ OUTPUT_ISOLATEDSURROGATE; \
+ continue; /* Rerun loop so length checks etc. repeated */ \
+ } else \
+ (void) 0
+
profile = ENCODING_PROFILE_GET(flags);
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
@@ -2481,6 +2525,8 @@ UtfToUtfProc(
}
if (UCHAR(*src) < 0x80
&& !((UCHAR(*src) == 0) && (flags & ENCODING_INPUT))) {
+
+ CHECK_ISOLATEDSURROGATE;
/*
* Copy 7bit characters, but skip null-bytes when we are in input
* mode, so that they get converted to \xC0\x80.
@@ -2490,6 +2536,8 @@ UtfToUtfProc(
(UCHAR(src[1]) == 0x80) &&
(!(flags & ENCODING_INPUT) || !PROFILE_TCL8(profile))) {
/* Special sequence \xC0\x80 */
+
+ CHECK_ISOLATEDSURROGATE;
if (!PROFILE_TCL8(profile) && (flags & ENCODING_INPUT)) {
if (PROFILE_REPLACE(profile)) {
dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst);
@@ -2510,12 +2558,12 @@ UtfToUtfProc(
} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
/*
- * Incomplete byte sequence.
- * Always check before using Tcl_UtfToUniChar. Not doing so can cause
- * it to 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.
- */
+ * Incomplete byte sequence not because there are insufficient
+ * bytes in source buffer (have already checked that above) but
+ * because the UTF-8 sequence is truncated.
+ */
+
+ CHECK_ISOLATEDSURROGATE;
if (flags & ENCODING_INPUT) {
/* Incomplete bytes for modified UTF-8 target */
@@ -2537,7 +2585,12 @@ UtfToUtfProc(
}
dst += Tcl_UniCharToUtf(ch, dst);
} else {
+ /* Have a complete character */
size_t len = TclUtfToUniChar(src, &ch);
+
+ Tcl_UniChar savedSurrogate = (Tcl_UniChar) (ptrdiff_t)*statePtr;
+ *statePtr = 0; /* Reset surrogate */
+
if (flags & ENCODING_INPUT) {
if (((len < 2) && (ch != 0))
|| ((ch > 0xFFFF) && !(flags & ENCODING_UTF))) {
@@ -2554,6 +2607,8 @@ UtfToUtfProc(
src += len;
if (!(flags & ENCODING_UTF) && !(flags & ENCODING_INPUT)
&& (ch > 0x3FF)) {
+ assert(savedSurrogate == 0); /* Since this flag combo
+ will never set *statePtr */
if (ch > 0xFFFF) {
/* CESU-8 6-byte sequence for chars > U+FFFF */
ch -= 0x10000;
@@ -2567,19 +2622,98 @@ UtfToUtfProc(
*dst++ = (char)((ch | 0x80) & 0xBF);
continue;
} else if (SURROGATE(ch)) {
- if (PROFILE_STRICT(profile)) {
- result = (flags & ENCODING_INPUT)
+ if ((flags & ENCODING_UTF)) {
+ /* UTF-8, not CESU-8, so surrogates should not appear */
+ if (PROFILE_STRICT(profile)) {
+ result = (flags & ENCODING_INPUT)
? TCL_CONVERT_SYNTAX : TCL_CONVERT_UNKNOWN;
- src = saveSrc;
- break;
- } else if (PROFILE_REPLACE(profile)) {
- ch = UNICODE_REPLACE_CHAR;
- }
- }
+ src = saveSrc;
+ break;
+ } else if (PROFILE_REPLACE(profile)) {
+ ch = UNICODE_REPLACE_CHAR;
+ } else {
+ /* PROFILE_TCL8 - output as is */
+ }
+ } else {
+ /* CESU-8 */
+ if (LOW_SURROGATE(ch)) {
+ if (savedSurrogate) {
+ assert(HIGH_SURROGATE(savedSurrogate));
+ ch = 0x10000 + ((savedSurrogate - 0xd800) << 10) + (ch - 0xdc00);
+ } else {
+ /* Isolated low surrogate */
+ if (PROFILE_STRICT(profile)) {
+ result = (flags & ENCODING_INPUT)
+ ? TCL_CONVERT_SYNTAX : TCL_CONVERT_UNKNOWN;
+ src = saveSrc;
+ break;
+ } else if (PROFILE_REPLACE(profile)) {
+ ch = UNICODE_REPLACE_CHAR;
+ } else {
+ /* Tcl8 profile. Output low surrogate as is */
+ }
+ }
+ } else {
+ assert(HIGH_SURROGATE(ch));
+ /* Save the high surrogate */
+ *statePtr = (Tcl_EncodingState) (ptrdiff_t) ch;
+ if (savedSurrogate) {
+ assert(HIGH_SURROGATE(savedSurrogate));
+ if (PROFILE_STRICT(profile)) {
+ result = (flags & ENCODING_INPUT)
+ ? TCL_CONVERT_SYNTAX : TCL_CONVERT_UNKNOWN;
+ src = saveSrc;
+ break;
+ } else if (PROFILE_REPLACE(profile)) {
+ ch = UNICODE_REPLACE_CHAR;
+ } else {
+ /* Output the isolated high surrogate */
+ ch = savedSurrogate;
+ }
+ } else {
+ /* High surrogate saved in *statePtr. Do not output anything just yet. */
+ --numChars; /* Cancel the increment at end of loop */
+ continue;
+ }
+ }
+ }
+ } else {
+ /* Normal character */
+ CHECK_ISOLATEDSURROGATE;
+ }
+
dst += Tcl_UniCharToUtf(ch, dst);
}
}
+ /* Check if an high surrogate left over */
+ if (*statePtr) {
+ assert(!(flags & ENCODING_UTF)); /* CESU-8, Not UTF-8 */
+ if (!(flags & TCL_ENCODING_END)) {
+ /* More data coming */
+ } else {
+ /* No more data coming */
+ if (PROFILE_STRICT(profile)) {
+ result = (flags & ENCODING_INPUT)
+ ? TCL_CONVERT_SYNTAX : TCL_CONVERT_UNKNOWN;
+ } else {
+ if (PROFILE_REPLACE(profile)) {
+ ch = UNICODE_REPLACE_CHAR;
+ } else {
+ ch = (Tcl_UniChar) (ptrdiff_t) *statePtr;
+ }
+ if (dst < dstEnd) {
+ dst += Tcl_UniCharToUtf(ch, dst);
+ ++numChars;
+ } else {
+ /* No room in destination */
+ result = TCL_CONVERT_NOSPACE;
+ }
+ }
+ }
+
+ }
+
*srcReadPtr = src - srcStart;
*dstWrotePtr = dst - dstStart;
*dstCharsPtr = numChars;
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index c8449aa..859366f 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -522,9 +522,10 @@ TclChanCreateObjCmd(
* Actually: rCreate MODE CMDPREFIX
* [0] [1] [2]
*/
-
-#define MODE (1)
-#define CMD (2)
+ enum ArgIndices {
+ MODE = 1,
+ CMD = 2
+ };
/*
* Number of arguments...
@@ -739,9 +740,6 @@ TclChanCreateObjCmd(
Tcl_DecrRefCount(rcPtr->cmd);
Tcl_Free(rcPtr);
return TCL_ERROR;
-
-#undef MODE
-#undef CMD
}
/*
@@ -826,9 +824,10 @@ TclChanPostEventObjCmd(
*
* where EVENTSPEC = {read write ...} (Abbreviations allowed as well).
*/
-
-#define CHAN (1)
-#define EVENT (2)
+ enum ArgIndices {
+ CHAN = 1,
+ EVENT = 2
+ };
const char *chanId; /* Tcl level channel handle */
Tcl_Channel chan; /* Channel associated to the handle */
@@ -980,9 +979,6 @@ TclChanPostEventObjCmd(
Tcl_ResetResult(interp);
return TCL_OK;
-
-#undef CHAN
-#undef EVENT
}
/*
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index dce1a1c..d2853e2 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -529,9 +529,10 @@ TclChanPushObjCmd(
* Actually: rPush CHANNEL CMDPREFIX
* [0] [1] [2]
*/
-
-#define CHAN (1)
-#define CMD (2)
+ enum ArgIndices {
+ CHAN = 1,
+ CMD = 2
+ };
/*
* Number of arguments...
@@ -714,9 +715,6 @@ TclChanPushObjCmd(
Tcl_EventuallyFree(rtPtr, FreeReflectedTransform);
return TCL_ERROR;
-
-#undef CHAN
-#undef CMD
}
/*
@@ -751,8 +749,9 @@ TclChanPopObjCmd(
* Actually: rPop CHANNEL
* [0] [1]
*/
-
-#define CHAN (1)
+ enum ArgIndices {
+ CHAN = 1
+ };
const char *chanId; /* Tcl level channel handle */
Tcl_Channel chan; /* Channel associated to the handle */
@@ -786,8 +785,6 @@ TclChanPopObjCmd(
Tcl_UnstackChannel(interp, chan);
return TCL_OK;
-
-#undef CHAN
}
/*
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 461fc54..250e43e 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -455,8 +455,8 @@ InitFoundation(
* Make the configurable class and install its standard defined method.
*/
- Tcl_Object cfgCls = Tcl_NewObjectInstance(interp,
- (Tcl_Class) fPtr->classCls,
+ Tcl_Object cfgCls = Tcl_NewObjectInstance(interp,
+ (Tcl_Class) fPtr->classCls,
"::oo::configuresupport::configurable", NULL, -1, NULL, 0);
for (i = 0 ; cfgMethods[i].name ; i++) {
TclOONewBasicMethod(((Object *) cfgCls)->classPtr, &cfgMethods[i]);
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 0e5513a..8f5988d 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -3394,7 +3394,7 @@ Configurable_ObjectWritableProps_Set(
* instance.
*
* BuildPropertyList --
- *
+ *
* Helper for the helpers. Scans a property list and does the filtering
* or adding of the property to add or remove
*
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index 3ef395c..02ab2e2 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -409,7 +409,7 @@ struct Foundation {
/*
* The number of MInvoke records in the CallChain before we allocate
- * separately.
+ * separately.
*/
#define CALL_CHAIN_STATIC_SIZE 4
diff --git a/generic/tclOOProp.c b/generic/tclOOProp.c
index 4cff300..a8b2002 100644
--- a/generic/tclOOProp.c
+++ b/generic/tclOOProp.c
@@ -25,7 +25,7 @@ enum GPNFlags {
};
/*
- * Shared bits for [property] declarations.
+ * Shared bits for [property] declarations.
*/
enum PropOpt {
PROP_ALL, PROP_READABLE, PROP_WRITABLE
@@ -212,7 +212,7 @@ GetPropertyName(
*/
Tcl_InterpState foo = Tcl_SaveInterpState(interp, result);
- Tcl_Obj *otherName = GetPropertyName(interp, oPtr,
+ Tcl_Obj *otherName = GetPropertyName(interp, oPtr,
flags ^ (GPN_WRITABLE | GPN_FALLING_BACK), namePtr, NULL);
result = Tcl_RestoreInterpState(interp, foo);
if (otherName != NULL) {
@@ -334,7 +334,7 @@ TclOO_Configurable_Configure(
code = TCL_OK;
for (i = 0; i < objc; i += 2) {
- namePtr = GetPropertyName(interp, oPtr, GPN_WRITABLE, objv[i],
+ namePtr = GetPropertyName(interp, oPtr, GPN_WRITABLE, objv[i],
&cache);
if (namePtr == NULL) {
code = TCL_ERROR;
@@ -381,7 +381,7 @@ Configurable_Getter(
Tcl_Obj *valuePtr;
if ((int) Tcl_ObjectContextSkippedArgs(context) != objc) {
- Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context),
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context),
objv, NULL);
return TCL_ERROR;
}
@@ -416,7 +416,7 @@ Configurable_Setter(
Tcl_Var varPtr, aryVar;
if ((int) Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
- Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context),
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context),
objv, "value");
return TCL_ERROR;
}
@@ -465,7 +465,7 @@ DetailsCloner(
* Installs a basic property implementation for a property, either on
* an instance or on a class. It's up to the code that calls these
* to ensure that the property name is syntactically valid.
- *
+ *
* ----------------------------------------------------------------------
*/
@@ -1318,7 +1318,7 @@ ReleasePropertyList(
{
Tcl_Obj *propertyObj;
Tcl_Size i;
-
+
FOREACH(propertyObj, *propList) {
Tcl_DecrRefCount(propertyObj);
}
diff --git a/win/Makefile.in b/win/Makefile.in
index bd6d693..35de31d 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -1151,7 +1151,7 @@ $(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \
$(GENERIC_DIR)/tclOOScript.h: $(TOOL_DIR)/tclOOScript.tcl
@echo "Warning: tclOOScript.h may be out of date."
- @echo "Developers may want to run \"make genscript\" to regenerate."
+ @echo "Developers may want to run \"make genscript\" to regenerate."
@echo "This warning can be safely ignored, do not report as a bug!"
genstubs:
diff --git a/win/configure b/win/configure
index 37b0d71..ae1bf30 100755
--- a/win/configure
+++ b/win/configure
@@ -4435,7 +4435,7 @@ fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_enable_auto_image_base" >&5
printf "%s\n" "$ac_cv_enable_auto_image_base" >&6; }
CFLAGS=$hold_cflags
- if test "$ac_cv_enable_auto_image_base" == "yes" ; then
+ if test "$ac_cv_enable_auto_image_base" = "yes" ; then
extra_ldflags="$extra_ldflags -Wl,--enable-auto-image-base"
fi
@@ -4960,7 +4960,7 @@ printf "%s\n" "#define MP_64BIT 1" >>confdefs.h
if test "$do64bit" = "arm64"
then :
- if test "$GCC" == "yes"
+ if test "$GCC" = "yes"
then :
ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64-arm/libz.dll.a
@@ -4982,7 +4982,7 @@ fi
else case e in #(
e)
- if test "$GCC" == "yes"
+ if test "$GCC" = "yes"
then :
ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/libz.dll.a
diff --git a/win/configure.ac b/win/configure.ac
index 9a5de1d..0bd254d 100644
--- a/win/configure.ac
+++ b/win/configure.ac
@@ -130,7 +130,7 @@ AS_IF([test "$tcl_ok" = "yes"], [
AS_IF([test "$do64bit" != "no"], [
AC_DEFINE(MP_64BIT, 1, [Using libtommath.dll in 64-bit mode])
AS_IF([test "$do64bit" = "arm64"], [
- AS_IF([test "$GCC" == "yes"],[
+ AS_IF([test "$GCC" = "yes"],[
AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64-arm/libz.dll.a])
AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64-arm/libtommath.dll.a])
zlib_lib_name=libz.dll.a
@@ -140,7 +140,7 @@ AS_IF([test "$tcl_ok" = "yes"], [
AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64-arm/tommath.lib])
])
], [
- AS_IF([test "$GCC" == "yes"],[
+ AS_IF([test "$GCC" = "yes"],[
AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/libz.dll.a])
AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64/libtommath.dll.a])
zlib_lib_name=libz.dll.a
diff --git a/win/tcl.m4 b/win/tcl.m4
index 23e916c..3b7e582 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -644,7 +644,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
[ac_cv_enable_auto_image_base=no])
)
CFLAGS=$hold_cflags
- if test "$ac_cv_enable_auto_image_base" == "yes" ; then
+ if test "$ac_cv_enable_auto_image_base" = "yes" ; then
extra_ldflags="$extra_ldflags -Wl,--enable-auto-image-base"
fi
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 68e22cb..1034392 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -52,8 +52,9 @@
* The following flag is used in OpenKeys to indicate that the specified key
* should be created if it doesn't currently exist.
*/
-
-#define REG_CREATE 1
+enum OpenKeysFlags {
+ REG_CREATE = 1
+};
/*
* The following tables contain the mapping from registry root names to the
@@ -386,7 +387,7 @@ RegistryObjCmd(
*/
mode |= KEY_ALL_ACCESS;
- if (OpenKey(interp, objv[n], mode, 1, &key) != TCL_OK) {
+ if (OpenKey(interp, objv[n], mode, REG_CREATE, &key) != TCL_OK) {
return TCL_ERROR;
}
RegCloseKey(key);
@@ -1310,7 +1311,7 @@ SetValue(
Tcl_ResetResult(interp);
}
mode |= KEY_ALL_ACCESS;
- if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) {
+ if (OpenKey(interp, keyNameObj, mode, REG_CREATE, &key) != TCL_OK) {
return TCL_ERROR;
}
generated by cgit v0.12 at 2024-11-16 13:01:09 (GMT)