summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2023-07-28 14:40:46 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2023-07-28 14:40:46 (GMT)
commit4eb2a153b7c2e256c5ce2eab6f0a050214045cc5 (patch)
treef0a29ec3d4785cc86f99c0192885596f29e221a5
parent861b69164d829d247b7d86a50ebf1821ef441118 (diff)
parent8225b1fd250bbd3d71a52ca514ae343a91dfcdc5 (diff)
downloadtcl-4eb2a153b7c2e256c5ce2eab6f0a050214045cc5.zip
tcl-4eb2a153b7c2e256c5ce2eab6f0a050214045cc5.tar.gz
tcl-4eb2a153b7c2e256c5ce2eab6f0a050214045cc5.tar.bz2
Rebase to 9.0
-rw-r--r--doc/Encoding.38
-rw-r--r--doc/chan.n7
-rw-r--r--doc/encoding.n15
-rw-r--r--generic/tcl.h9
-rw-r--r--generic/tclCmdAH.c24
-rw-r--r--generic/tclEncoding.c79
-rw-r--r--generic/tclFCmd.c63
-rw-r--r--generic/tclIO.c22
-rw-r--r--generic/tclIOSock.c12
-rw-r--r--generic/tclInt.h7
-rw-r--r--generic/tclZipfs.c12
-rw-r--r--library/http/http.tcl12
-rw-r--r--tests/encodingVectors.tcl2
-rw-r--r--tests/ioCmd.test8
-rw-r--r--unix/tclLoadDl.c12
-rw-r--r--unix/tclLoadDyld.c14
-rw-r--r--unix/tclLoadNext.c27
-rw-r--r--unix/tclLoadOSF.c32
-rw-r--r--unix/tclLoadShl.c10
-rw-r--r--unix/tclUnixFCmd.c138
-rw-r--r--unix/tclUnixFile.c68
-rw-r--r--unix/tclUnixPipe.c23
-rw-r--r--win/tclWinPipe.c11
23 files changed, 385 insertions, 230 deletions
diff --git a/doc/Encoding.3 b/doc/Encoding.3
index 9fac9e9..68903b2 100644
--- a/doc/Encoding.3
+++ b/doc/Encoding.3
@@ -105,9 +105,9 @@ byte is converted and then to reset to an initial state. The
\fBTCL_PROFILE_*\fR bits defined in the \fBPROFILES\fR section below
control the encoding profile to be used for dealing with invalid data or
other errors in the encoding transform.
-\fBTCL_ENCODING_STOPONERROR\fR is present for backward compatibility with
-Tcl 8.6 and forces the encoding profile to \fBstrict\fR.
-
+The flag \fBTCL_ENCODING_STOPONERROR\fR has no effect,
+it only has meaning in Tcl 8.x.
+.PP
Some flags bits may not be usable with some functions as noted in the
function descriptions below.
.AP Tcl_EncodingState *statePtr in/out
@@ -589,7 +589,7 @@ with at most one of \fBTCL_ENCODING_PROFILE_TCL8\fR,
\fBTCL_ENCODING_PROFILE_STRICT\fR or \fBTCL_ENCODING_PROFILE_REPLACE\fR.
These correspond to the \fBtcl8\fR, \fBstrict\fR and \fBreplace\fR profiles
respectively. If none are specified, a version-dependent default profile is used.
-For Tcl 9.0, the default profile is \fBtcl8\fR.
+For Tcl 9.0, the default profile is \fBstrict\fR.
.PP
For details about profiles, see the \fBPROFILES\fR section in
the documentation of the \fBencoding\fR command.
diff --git a/doc/chan.n b/doc/chan.n
index 75615b6..2361fde 100644
--- a/doc/chan.n
+++ b/doc/chan.n
@@ -200,16 +200,15 @@ platforms it is \fBcrlf\fR for both input and output.
\fBbinary\fR
.
Like \fBlf\fR, no end-of-line translation is performed, but in addition, sets
-\fB\-eofchar\fR to the empty string to disable it, sets \fB\-encoding\fR to
-\fBiso8859-1\fR, and sets \fB-profile\fR to \fBstrict\fR so the the channel is
-fully configured for binary input and output: Each byte read from the channel
+\fB\-eofchar\fR to the empty string to disable it, and sets \fB\-encoding\fR
+to \fBiso8859-1\fR. With this one setting, a channel is fully configured
+for binary input and output: Each byte read from the channel
becomes the Unicode character having the same value as that byte, and each
character written to the channel becomes a single byte in the output. This
makes it possible to work seamlessly with binary data as long as each character
in the data remains in the range of 0 to 255 so that there is no distinction
between binary data and text. For example, A JPEG image can be read from a
such a channel, manipulated, and then written back to such a channel.
-
.TP
\fBcr\fR
.
diff --git a/doc/encoding.n b/doc/encoding.n
index 793348f..255e070 100644
--- a/doc/encoding.n
+++ b/doc/encoding.n
@@ -111,9 +111,14 @@ encoding.
The following profiles are currently implemented.
.VS "TCL8.7 TIP656"
.TP
+\fBstrict\fR
+.
+The default profile. The operation fails when invalid data for the encoding
+are encountered.
+.TP
\fBtcl8\fR
.
-The default profile. Provides for behaviour identical to that of Tcl 8.6: When
+Provides for behaviour identical to that of Tcl 8.6: When
decoding, for encodings \fBother than utf-8\fR, each invalid byte is interpreted
as the Unicode value given by that one byte. For example, the byte 0x80, which
is invalid in the ASCII encoding would be mapped to the Unicode value U+0080.
@@ -127,10 +132,6 @@ an additional special case, the sequence 0xC0 0x80 is mapped to U+0000.
When encoding, each character that cannot be represented in the encoding is
replaced by an encoding-dependent character, usually the question mark \fB?\fR.
.TP
-\fBstrict\fR
-.
-The operation fails when invalid data for the encoding are encountered.
-.TP
\fBreplace\fR
.
When decoding, invalid bytes are replaced by U+FFFD, the Unicode REPLACEMENT
@@ -180,7 +181,7 @@ unexpected byte sequence starting at index 1: '\ex80'
Example 3: Get partial data and the error location:
.PP
.CS
-% codepoints [encoding convertfrom -profile strict -failindex idx ascii AB\ex80]
+% codepoints [encoding convertfrom -failindex idx ascii AB\ex80]
U+000041 U+000042
% set idx
2
@@ -193,7 +194,7 @@ Example 4: Encode a character that is not representable in ISO8859-1:
A?
% encoding convertto -profile strict iso8859-1 A\eu0141
unexpected character at index 1: 'U+000141'
-% encoding convertto -profile strict -failindex idx iso8859-1 A\eu0141
+% encoding convertto -failindex idx iso8859-1 A\eu0141
A
% set idx
1
diff --git a/generic/tcl.h b/generic/tcl.h
index cae8fb6..005ca28 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2013,14 +2013,9 @@ typedef struct Tcl_EncodingType {
* changes, ensure ENCODING_PROFILE_* macros in tclInt.h are modified if
* necessary.
*/
+#define TCL_ENCODING_PROFILE_STRICT TCL_ENCODING_STOPONERROR
#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_REPLACE 0x02000000
/*
* The following definitions are the error codes returned by the conversion
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 3b9e5ba..a63d9d5 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -283,7 +283,12 @@ Tcl_CdObjCmd(
if (Tcl_FSConvertToPathType(interp, dir) != TCL_OK) {
result = TCL_ERROR;
} else {
- result = Tcl_FSChdir(dir);
+ Tcl_DString ds;
+ result = Tcl_UtfToExternalDStringEx(NULL, TCLFSENCODING, TclGetString(dir), -1, 0, &ds, NULL);
+ Tcl_DStringFree(&ds);
+ if (result == TCL_OK) {
+ result = Tcl_FSChdir(dir);
+ }
if (result != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't change working directory to \"%s\": %s",
@@ -434,7 +439,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:
@@ -2234,10 +2239,16 @@ CheckAccess(
* access(). */
{
int value;
+ Tcl_DString ds;
if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
value = 0;
+ } else if (Tcl_UtfToExternalDStringEx(NULL, TCLFSENCODING, TclGetString(pathPtr),
+ TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ value = 0;
+ Tcl_DStringFree(&ds);
} else {
+ Tcl_DStringFree(&ds);
value = (Tcl_FSAccess(pathPtr, mode) == 0);
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
@@ -2275,12 +2286,19 @@ GetStatBuf(
* calling (*statProc)(). */
{
int status;
+ Tcl_DString ds;
if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
return TCL_ERROR;
}
- status = statProc(pathPtr, statPtr);
+ if (Tcl_UtfToExternalDStringEx(NULL, TCLFSENCODING, TclGetString(pathPtr),
+ TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ status = -1;
+ } else {
+ status = statProc(pathPtr, statPtr);
+ }
+ Tcl_DStringFree(&ds);
if (status < 0) {
if (interp != NULL) {
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 6cec532..860cb48 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -201,17 +201,13 @@ static struct TclEncodingProfiles {
{"tcl8", TCL_ENCODING_PROFILE_TCL8},
};
#define PROFILE_TCL8(flags_) \
- ((ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_TCL8) \
- || (ENCODING_PROFILE_GET(flags_) == 0 \
- && TCL_ENCODING_PROFILE_DEFAULT == TCL_ENCODING_PROFILE_TCL8))
+ (ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_TCL8)
+
+#define PROFILE_REPLACE(flags_) \
+ (ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE)
+
#define PROFILE_STRICT(flags_) \
- ((ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_STRICT) \
- || (ENCODING_PROFILE_GET(flags_) == 0 \
- && TCL_ENCODING_PROFILE_DEFAULT == TCL_ENCODING_PROFILE_STRICT))
-#define PROFILE_REPLACE(flags_) \
- ((ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) \
- || (ENCODING_PROFILE_GET(flags_) == 0 \
- && TCL_ENCODING_PROFILE_DEFAULT == TCL_ENCODING_PROFILE_REPLACE))
+ (!PROFILE_TCL8(flags_) && !PROFILE_REPLACE(flags_))
#define UNICODE_REPLACE_CHAR ((Tcl_UniChar)0xFFFD)
#define SURROGATE(c_) (((c_) & ~0x7FF) == 0xD800)
@@ -1174,10 +1170,6 @@ Tcl_ExternalToUtfDString(
* Possible flags values:
* target encoding. It should be composed by OR-ing the following:
* - *At most one* of TCL_ENCODING_PROFILE{DEFAULT,TCL8,STRICT}
- * - TCL_ENCODING_STOPONERROR: Backward compatibility. Sets the profile
- * to TCL_ENCODING_PROFILE_STRICT overriding any specified profile flags
- * Any other flag bits will cause an error to be returned (for future
- * compatibility)
*
* Results:
* The return value is one of
@@ -1508,8 +1500,6 @@ Tcl_UtfToExternalDString(
* the source buffer are invalid or cannot be represented in the
* target encoding. It should be composed by OR-ing the following:
* - *At most one* of TCL_ENCODING_PROFILE_*
- * - TCL_ENCODING_STOPONERROR: Backward compatibility. Sets the profile
- * to TCL_ENCODING_PROFILE_STRICT overriding any specified profile flags
*
* Results:
* The return value is one of
@@ -2463,7 +2453,6 @@ BinaryProc(
if (dstLen < 0) {
dstLen = 0;
}
- flags = TclEncodingSetProfileFlags(flags);
if ((flags & TCL_ENCODING_CHAR_LIMIT) && srcLen > *dstCharsPtr) {
srcLen = *dstCharsPtr;
}
@@ -2531,7 +2520,6 @@ UtfToUtfProc(
srcStart = src;
srcEnd = src + srcLen;
srcClose = srcEnd;
- flags = TclEncodingSetProfileFlags(flags);
if ((flags & TCL_ENCODING_END) == 0) {
srcClose -= 6;
}
@@ -2760,7 +2748,6 @@ Utf32ToUtfProc(
int result, numChars, charLimit = INT_MAX;
int ch = 0, bytesLeft = srcLen % 4;
- flags = TclEncodingSetProfileFlags(flags);
flags |= PTR2INT(clientData);
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
@@ -2940,7 +2927,6 @@ UtfToUtf32Proc(
srcStart = src;
srcEnd = src + srcLen;
srcClose = srcEnd;
- flags = TclEncodingSetProfileFlags(flags);
if ((flags & TCL_ENCODING_END) == 0) {
srcClose -= TCL_UTF_MAX;
}
@@ -3038,7 +3024,6 @@ Utf16ToUtfProc(
int result, numChars, charLimit = INT_MAX;
unsigned short ch = 0;
- flags = TclEncodingSetProfileFlags(flags);
flags |= PTR2INT(clientData);
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
@@ -3228,7 +3213,6 @@ UtfToUtf16Proc(
srcStart = src;
srcEnd = src + srcLen;
srcClose = srcEnd;
- flags = TclEncodingSetProfileFlags(flags);
if ((flags & TCL_ENCODING_END) == 0) {
srcClose -= TCL_UTF_MAX;
}
@@ -3334,7 +3318,6 @@ UtfToUcs2Proc(
int result, numChars, len;
Tcl_UniChar ch = 0;
- flags = TclEncodingSetProfileFlags(flags);
flags |= PTR2INT(clientData);
srcStart = src;
srcEnd = src + srcLen;
@@ -3457,7 +3440,6 @@ TableToUtfProc(
const unsigned short *pageZero;
TableEncodingData *dataPtr = (TableEncodingData *)clientData;
- flags = TclEncodingSetProfileFlags(flags);
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
}
@@ -3599,7 +3581,6 @@ TableFromUtfProc(
srcStart = src;
srcEnd = src + srcLen;
srcClose = srcEnd;
- flags = TclEncodingSetProfileFlags(flags);
if ((flags & TCL_ENCODING_END) == 0) {
srcClose -= TCL_UTF_MAX;
}
@@ -3629,7 +3610,7 @@ TableFromUtfProc(
word = 0;
} else
#endif
- word = fromUnicode[(ch >> 8)][ch & 0xFF];
+ word = fromUnicode[(ch >> 8)][ch & 0xFF];
if ((word == 0) && (ch != 0)) {
if (PROFILE_STRICT(flags)) {
@@ -3706,7 +3687,6 @@ Iso88591ToUtfProc(
const char *dstEnd, *dstStart;
int result, numChars, charLimit = INT_MAX;
- flags = TclEncodingSetProfileFlags(flags);
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
}
@@ -3800,7 +3780,6 @@ Iso88591FromUtfProc(
srcStart = src;
srcEnd = src + srcLen;
srcClose = srcEnd;
- flags = TclEncodingSetProfileFlags(flags);
if ((flags & TCL_ENCODING_END) == 0) {
srcClose -= TCL_UTF_MAX;
}
@@ -3948,7 +3927,6 @@ EscapeToUtfProc(
int state, result, numChars, charLimit = INT_MAX;
const char *dstStart, *dstEnd;
- flags = TclEncodingSetProfileFlags(flags);
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
}
@@ -4179,7 +4157,6 @@ EscapeFromUtfProc(
srcStart = src;
srcEnd = src + srcLen;
srcClose = srcEnd;
- flags = TclEncodingSetProfileFlags(flags);
if ((flags & TCL_ENCODING_END) == 0) {
srcClose -= TCL_UTF_MAX;
}
@@ -4628,48 +4605,6 @@ TclEncodingProfileIdToName(
/*
*------------------------------------------------------------------------
*
- * TclEncodingSetProfileFlags --
- *
- * Maps the flags supported in the encoding C API's to internal flags.
- *
- * For backward compatibility reasons, TCL_ENCODING_STOPONERROR is
- * is mapped to the TCL_ENCODING_PROFILE_STRICT overwriting any profile
- * specified.
- *
- * If no profile or an invalid profile is specified, it is set to
- * the default.
- *
- * Results:
- * Internal encoding flag mask.
- *
- * Side effects:
- * None.
- *
- *------------------------------------------------------------------------
- */
-int TclEncodingSetProfileFlags(int flags)
-{
- if (flags & TCL_ENCODING_STOPONERROR) {
- ENCODING_PROFILE_SET(flags, TCL_ENCODING_PROFILE_STRICT);
- } else {
- int profile = ENCODING_PROFILE_GET(flags);
- switch (profile) {
- case TCL_ENCODING_PROFILE_TCL8:
- case TCL_ENCODING_PROFILE_STRICT:
- case TCL_ENCODING_PROFILE_REPLACE:
- break;
- case 0: /* Unspecified by caller */
- default:
- ENCODING_PROFILE_SET(flags, TCL_ENCODING_PROFILE_DEFAULT);
- break;
- }
- }
- return flags;
-}
-
-/*
- *------------------------------------------------------------------------
- *
* TclGetEncodingProfiles --
*
* Get the list of supported encoding profiles.
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index ca4ff27..68eaab5 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -113,6 +113,7 @@ FileCopyRename(
int i, result, force;
Tcl_StatBuf statBuf;
Tcl_Obj *target;
+ Tcl_DString ds;
i = FileForceOption(interp, objc - 1, objv + 1, &force);
if (i < 0) {
@@ -134,6 +135,12 @@ FileCopyRename(
if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) {
return TCL_ERROR;
}
+ if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(target),
+ TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+ Tcl_DStringFree(&ds);
result = TCL_OK;
@@ -225,6 +232,7 @@ TclFileMakeDirsCmd(
Tcl_Obj *split = NULL;
Tcl_Obj *target = NULL;
Tcl_StatBuf statBuf;
+ Tcl_DString ds;
result = TCL_OK;
for (i = 1; i < objc; i++) {
@@ -232,6 +240,13 @@ TclFileMakeDirsCmd(
result = TCL_ERROR;
break;
}
+ if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[i]),
+ TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ result = TCL_ERROR;
+ break;
+ }
+ Tcl_DStringFree(&ds);
split = Tcl_FSSplitPath(objv[i], &pobjc);
Tcl_IncrRefCount(split);
@@ -347,6 +362,7 @@ TclFileDeleteCmd(
int i, force, result;
Tcl_Obj *errfile;
Tcl_Obj *errorBuffer = NULL;
+ Tcl_DString ds;
i = FileForceOption(interp, objc - 1, objv + 1, &force);
if (i < 0) {
@@ -364,6 +380,13 @@ TclFileDeleteCmd(
result = TCL_ERROR;
goto done;
}
+ if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[i]),
+ TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ result = TCL_ERROR;
+ goto done;
+ }
+ Tcl_DStringFree(&ds);
/*
* Call lstat() to get info so can delete symbolic link itself.
@@ -483,13 +506,26 @@ CopyRenameOneFile(
Tcl_Obj *actualSource=NULL; /* If source is a link, then this is the real
* file/directory. */
Tcl_StatBuf sourceStatBuf, targetStatBuf;
+ Tcl_DString ds;
if (Tcl_FSConvertToPathType(interp, source) != TCL_OK) {
return TCL_ERROR;
}
+ if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(source),
+ TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+ Tcl_DStringFree(&ds);
if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) {
return TCL_ERROR;
}
+ if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(target),
+ TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+ Tcl_DStringFree(&ds);
errfile = NULL;
errorBuffer = NULL;
@@ -949,6 +985,7 @@ TclFileAttrsCmd(
Tcl_Obj *objStrings = NULL;
Tcl_Size numObjStrings = TCL_INDEX_NONE;
Tcl_Obj *filePtr;
+ Tcl_DString ds;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name ?-option value ...?");
@@ -959,6 +996,12 @@ TclFileAttrsCmd(
if (Tcl_FSConvertToPathType(interp, filePtr) != TCL_OK) {
return TCL_ERROR;
}
+ if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(filePtr),
+ TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+ Tcl_DStringFree(&ds);
objc -= 2;
objv += 2;
@@ -1161,6 +1204,7 @@ TclFileLinkCmd(
{
Tcl_Obj *contents;
int index;
+ Tcl_DString ds;
if (objc < 2 || objc > 4) {
Tcl_WrongNumArgs(interp, 1, objv, "?-linktype? linkname ?target?");
@@ -1203,6 +1247,12 @@ TclFileLinkCmd(
if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
return TCL_ERROR;
}
+ if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[index]),
+ TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+ Tcl_DStringFree(&ds);
/*
* Create link from source to target.
@@ -1260,6 +1310,12 @@ TclFileLinkCmd(
if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
return TCL_ERROR;
}
+ if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[index]),
+ TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+ Tcl_DStringFree(&ds);
/*
* Read link
@@ -1311,6 +1367,7 @@ TclFileReadLinkCmd(
Tcl_Obj *const objv[])
{
Tcl_Obj *contents;
+ Tcl_DString ds;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
@@ -1320,6 +1377,12 @@ TclFileReadLinkCmd(
if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
return TCL_ERROR;
}
+ if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[1]),
+ TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+ Tcl_DStringFree(&ds);
contents = Tcl_FSLink(objv[1], NULL, 0);
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 0c91428..6b74af4 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -1680,12 +1680,8 @@ Tcl_CreateChannel(
statePtr->encoding = Tcl_GetEncoding(NULL, name);
statePtr->inputEncodingState = NULL;
statePtr->inputEncodingFlags = TCL_ENCODING_START;
- ENCODING_PROFILE_SET(statePtr->inputEncodingFlags,
- TCL_ENCODING_PROFILE_DEFAULT);
statePtr->outputEncodingState = NULL;
statePtr->outputEncodingFlags = TCL_ENCODING_START;
- ENCODING_PROFILE_SET(statePtr->outputEncodingFlags,
- TCL_ENCODING_PROFILE_DEFAULT);
/*
* Set the channel up initially in AUTO input translation mode to accept
@@ -8167,12 +8163,6 @@ Tcl_SetChannelOption(
if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) {
encoding = Tcl_GetEncoding(NULL, "iso8859-1");
- ENCODING_PROFILE_SET(statePtr->inputEncodingFlags
- ,ENCODING_PROFILE_GET(statePtr->inputEncodingFlags)
- |TCL_ENCODING_PROFILE_STRICT);
- ENCODING_PROFILE_SET(statePtr->outputEncodingFlags
- ,ENCODING_PROFILE_GET(statePtr->outputEncodingFlags)
- |TCL_ENCODING_PROFILE_STRICT);
} else {
encoding = Tcl_GetEncoding(interp, newValue);
if (encoding == NULL) {
@@ -8281,12 +8271,6 @@ Tcl_SetChannelOption(
statePtr->inEofChar = 0;
Tcl_FreeEncoding(statePtr->encoding);
statePtr->encoding = Tcl_GetEncoding(NULL, "iso8859-1");
- ENCODING_PROFILE_SET(statePtr->inputEncodingFlags
- ,ENCODING_PROFILE_GET(statePtr->inputEncodingFlags)
- |TCL_ENCODING_PROFILE_STRICT);
- ENCODING_PROFILE_SET(statePtr->outputEncodingFlags
- ,ENCODING_PROFILE_GET(statePtr->outputEncodingFlags)
- |TCL_ENCODING_PROFILE_STRICT);
} else if (strcmp(readMode, "lf") == 0) {
translation = TCL_TRANSLATE_LF;
} else if (strcmp(readMode, "cr") == 0) {
@@ -8336,12 +8320,6 @@ Tcl_SetChannelOption(
statePtr->outputTranslation = TCL_TRANSLATE_LF;
Tcl_FreeEncoding(statePtr->encoding);
statePtr->encoding = Tcl_GetEncoding(NULL, "iso8859-1");
- ENCODING_PROFILE_SET(statePtr->inputEncodingFlags
- ,ENCODING_PROFILE_GET(statePtr->inputEncodingFlags)
- |TCL_ENCODING_PROFILE_STRICT);
- ENCODING_PROFILE_SET(statePtr->outputEncodingFlags
- ,ENCODING_PROFILE_GET(statePtr->outputEncodingFlags)
- |TCL_ENCODING_PROFILE_STRICT);
} else if (strcmp(writeMode, "lf") == 0) {
statePtr->outputTranslation = TCL_TRANSLATE_LF;
} else if (strcmp(writeMode, "cr") == 0) {
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index c6cef55..4b2c637 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -75,7 +75,11 @@ TclSockGetPort(
* Don't bother translating 'proto' to native.
*/
- native = Tcl_UtfToExternalDString(NULL, string, -1, &ds);
+ if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, string, -1, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+ native = Tcl_DStringValue(&ds);
sp = getservbyname(native, proto); /* INTL: Native. */
Tcl_DStringFree(&ds);
if (sp != NULL) {
@@ -184,7 +188,11 @@ TclCreateSocketAddress(
int result;
if (host != NULL) {
- native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
+ if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, host, -1, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return 0;
+ }
+ native = Tcl_DStringValue(&ds);
}
/*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1b6b3c4..97979d5 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2878,6 +2878,12 @@ typedef Tcl_Channel (TclOpenFileChannelProc_)(Tcl_Interp *interp,
typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, TCL_HASH_TYPE *lengthPtr,
Tcl_Encoding *encodingPtr);
+#ifdef _WIN32
+# define TCLFSENCODING tclUtf8Encoding /* On Windows, all Unicode (except surrogates) are valid */
+#else
+# define TCLFSENCODING NULL /* On Non-Windows, use the system encoding for validation checks */
+#endif
+
/*
* A ProcessGlobalValue struct exists for each internal value in Tcl that is
* to be shared among several threads. Each thread sees a (Tcl_Obj) copy of
@@ -3036,7 +3042,6 @@ TclEncodingProfileNameToId(Tcl_Interp *interp,
int *profilePtr);
MODULE_SCOPE const char *TclEncodingProfileIdToName(Tcl_Interp *interp,
int profileId);
-MODULE_SCOPE int TclEncodingSetProfileFlags(int flags);
MODULE_SCOPE void TclGetEncodingProfiles(Tcl_Interp *interp);
/*
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 2df7705..c4de094 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -2536,7 +2536,11 @@ ZipAddFile(
* crazy enough to embed NULs in filenames, they deserve what they get!
*/
- zpathExt = Tcl_UtfToExternalDString(tclUtf8Encoding, zpathTcl, -1, &zpathDs);
+ if (Tcl_UtfToExternalDStringEx(interp, tclUtf8Encoding, zpathTcl, TCL_INDEX_NONE, 0, &zpathDs, NULL) != TCL_OK) {
+ Tcl_DStringFree(&zpathDs);
+ return TCL_ERROR;
+ }
+ zpathExt = Tcl_DStringValue(&zpathDs);
zpathlen = strlen(zpathExt);
if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -3205,7 +3209,11 @@ ZipFSMkZipOrImg(
}
z = (ZipEntry *) Tcl_GetHashValue(hPtr);
- name = Tcl_UtfToExternalDString(tclUtf8Encoding, z->name, TCL_INDEX_NONE, &ds);
+ if (Tcl_UtfToExternalDStringEx(interp, tclUtf8Encoding, z->name, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ ret = TCL_ERROR;
+ goto done;
+ }
+ name = Tcl_DStringValue(&ds);
len = Tcl_DStringLength(&ds);
SerializeCentralDirectoryEntry(start, end, (unsigned char *) buf,
z, len);
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 6c3c068..c159cb5 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -1747,7 +1747,7 @@ 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
+ fconfigure $sock -profile replace
}
##Log socket opened, DONE fconfigure - token $token
}
@@ -2168,7 +2168,7 @@ proc http::Connected {token proto phost srvurl} {
fconfigure $sock -translation [list $trRead crlf] \
-buffersize $state(-blocksize)
if {[package vsatisfies [package provide Tcl] 9.0-]} {
- fconfigure $sock -profile tcl8
+ fconfigure $sock -profile replace
}
# The following is disallowed in safe interpreters, but the socket is
@@ -2561,7 +2561,7 @@ proc http::ReceiveResponse {token} {
fconfigure $sock -translation [list auto $trWrite] \
-buffersize $state(-blocksize)
if {[package vsatisfies [package provide Tcl] 9.0-]} {
- fconfigure $sock -profile tcl8
+ fconfigure $sock -profile replace
}
Log ^D$tk begin receiving response - token $token
@@ -4555,7 +4555,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)]
+ set state(body) [encoding convertfrom -profile replace $enc $state(body)]
} else {
set state(body) [encoding convertfrom $enc $state(body)]
}
@@ -4642,7 +4642,7 @@ proc http::GuessType {token} {
return 0
}
if {[package vsatisfies [package provide Tcl] 9.0-]} {
- set state(body) [encoding convertfrom -profile tcl8 $enc $state(body)]
+ set state(body) [encoding convertfrom -profile replace $enc $state(body)]
} else {
set state(body) [encoding convertfrom $enc $state(body)]
}
@@ -4727,7 +4727,7 @@ proc http::quoteString {string} {
# than [regsub]/[subst]). [Bug 1020491]
if {[package vsatisfies [package provide Tcl] 9.0-]} {
- set string [encoding convertto -profile tcl8 $http(-urlencoding) $string]
+ set string [encoding convertto -profile replace $http(-urlencoding) $string]
} else {
set string [encoding convertto $http(-urlencoding) $string]
}
diff --git a/tests/encodingVectors.tcl b/tests/encodingVectors.tcl
index 38b3da5..8bd6b87 100644
--- a/tests/encodingVectors.tcl
+++ b/tests/encodingVectors.tcl
@@ -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.
#
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index e603731..e347e86 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -240,11 +240,11 @@ test iocmd-8.7 {fconfigure command} -setup {
file delete $path(test1)
} -body {
set f1 [open $path(test1) w]
- fconfigure $f1 -translation lf -eofchar {} -encoding utf-16 -profile tcl8
+ fconfigure $f1 -translation lf -eofchar {} -encoding utf-16
fconfigure $f1
} -cleanup {
catch {close $f1}
-} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -eofchar {} -profile tcl8 -translation lf}
+} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -eofchar {} -profile strict -translation lf}
test iocmd-8.8 {fconfigure command} -setup {
file delete $path(test1)
set x {}
@@ -262,11 +262,11 @@ test iocmd-8.9 {fconfigure command} -setup {
} -body {
set f1 [open $path(test1) w]
fconfigure $f1 -translation binary -buffering none -buffersize 4040 \
- -eofchar {} -encoding binary -profile tcl8
+ -eofchar {} -encoding binary
fconfigure $f1
} -cleanup {
catch {close $f1}
-} -result {-blocking 1 -buffering none -buffersize 4040 -encoding iso8859-1 -eofchar {} -profile tcl8 -translation lf}
+} -result {-blocking 1 -buffering none -buffersize 4040 -encoding iso8859-1 -eofchar {} -profile strict -translation lf}
test iocmd-8.10 {fconfigure command} -returnCodes error -body {
fconfigure a b
} -result {can not find channel named "a"}
diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c
index 0913698..743e94f 100644
--- a/unix/tclLoadDl.c
+++ b/unix/tclLoadDl.c
@@ -108,7 +108,11 @@ TclpDlopen(
Tcl_DString ds;
const char *fileName = TclGetString(pathPtr);
- native = Tcl_UtfToExternalDString(NULL, fileName, TCL_INDEX_NONE, &ds);
+ if (Tcl_UtfToExternalDStringEx(interp, NULL, fileName, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+ native = Tcl_DStringValue(&ds);
/*
* Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070]
*/
@@ -179,7 +183,11 @@ FindSymbol(
* the underscore.
*/
- native = Tcl_UtfToExternalDString(NULL, symbol, TCL_INDEX_NONE, &ds);
+ if (Tcl_UtfToExternalDStringEx(interp, NULL, symbol, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return NULL;
+ }
+ native = Tcl_DStringValue(&ds);
proc = dlsym(handle, native); /* INTL: Native. */
if (proc == NULL) {
Tcl_DStringInit(&newName);
diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c
index cc3512d..67e1682 100644
--- a/unix/tclLoadDyld.c
+++ b/unix/tclLoadDyld.c
@@ -184,8 +184,12 @@ TclpDlopen(
*/
nativePath = (const char *)Tcl_FSGetNativePath(pathPtr);
- nativeFileName = Tcl_UtfToExternalDString(NULL, TclGetString(pathPtr),
- TCL_INDEX_NONE, &ds);
+ if (Tcl_UtfToExternalDStringEx(interp, NULL, TclGetString(pathPtr),
+ TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+ nativeFileName = Tcl_DStringValue(&ds);
#if TCL_DYLD_USE_DLFCN
/*
@@ -341,7 +345,11 @@ FindSymbol(
Tcl_DString ds;
const char *native;
- native = Tcl_UtfToExternalDString(NULL, symbol, TCL_INDEX_NONE, &ds);
+ if (Tcl_UtfToExternalDStringEx(interp, NULL, symbol, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return NULL;
+ }
+ native = Tcl_DStringValue(&ds);
if (dyldLoadHandle->dlHandle) {
#if TCL_DYLD_USE_DLFCN
proc = (Tcl_LibraryInitProc *)dlsym(dyldLoadHandle->dlHandle, native);
diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c
index 23de2c5..527e893 100644
--- a/unix/tclLoadNext.c
+++ b/unix/tclLoadNext.c
@@ -14,14 +14,17 @@
#include <mach-o/rld.h>
#include <streams/streams.h>
-/* Static procedures defined within this file */
+
+/*
+ * Static procedures defined within this file.
+ */
static void * FindSymbol(Tcl_Interp *interp,
- Tcl_LoadHandle loadHandle, const char* symbol);
+ Tcl_LoadHandle loadHandle, const char *symbol);
static void UnloadFile(Tcl_LoadHandle loadHandle);
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* TclpDlopen --
*
@@ -29,13 +32,13 @@ static void UnloadFile(Tcl_LoadHandle loadHandle);
* to the new code.
*
* Results:
- * A standard Tcl completion code. If an error occurs, an error message
+ * A standard Tcl completion code. If an error occurs, an error message
* is left in the interp's result.
*
* Side effects:
* New code suddenly appears in memory.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
int
@@ -78,12 +81,16 @@ TclpDlopen(
/*
* Let the OS loader examine the binary search path for whatever
* string the user gave us which hopefully refers to a file on the
- * binary path
+ * binary path.
*/
Tcl_DString ds;
- native = Tcl_UtfToExternalDString(NULL, fileName, TCL_INDEX_NONE, &ds);
+ if (Tcl_UtfToExternalDStringEx(interp, NULL, fileName, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+ native = Tcl_DStringValue(&ds);
files = {native,NULL};
result = rld_load(errorStream, &header, files, NULL);
Tcl_DStringFree(&ds);
@@ -101,12 +108,12 @@ TclpDlopen(
}
NXCloseMemory(errorStream, NX_FREEBUFFER);
- newHandle = (Tcl_LoadHandle) Tcl_Alloc(sizeof(*newHandle));
+ newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle));
newHandle->clientData = INT2PTR(1);
newHandle->findSymbolProcPtr = &FindSymbol;
newHandle->unloadFileProcPtr = &UnloadFile;
- *loadHandle = newHandle;
*unloadProcPtr = &UnloadFile;
+ *loadHandle = newHandle;
return TCL_OK;
}
@@ -169,7 +176,7 @@ FindSymbol(
*----------------------------------------------------------------------
*/
-void
+static void
UnloadFile(
Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to
* TclpDlopen(). The loadHandle is a token
diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c
index 852adca..79a869b 100644
--- a/unix/tclLoadOSF.c
+++ b/unix/tclLoadOSF.c
@@ -36,16 +36,17 @@
#include <sys/types.h>
#include <loader.h>
+
/*
- * Static functions defined within this file.
+ * Static procedures defined within this file.
*/
static void * FindSymbol(Tcl_Interp *interp,
- Tcl_LoadHandle loadHandle, const char* symbol);
-static void UnloadFile(Tcl_LoadHandle handle);
+ Tcl_LoadHandle loadHandle, const char *symbol);
+static void UnloadFile(Tcl_LoadHandle loadHandle);
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* TclpDlopen --
*
@@ -53,13 +54,13 @@ static void UnloadFile(Tcl_LoadHandle handle);
* to the new code.
*
* Results:
- * A standard Tcl completion code. If an error occurs, an error message
+ * A standard Tcl completion code. If an error occurs, an error message
* is left in the interp's result.
*
* Side effects:
* New code suddenly appears in memory.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
int
@@ -83,7 +84,7 @@ TclpDlopen(
const char *native;
/*
- * First try the full path the user gave us. This is particularly
+ * First try the full path the user gave us. This is particularly
* important if the cwd is inside a vfs, and we are trying to load using a
* relative path.
*/
@@ -100,7 +101,11 @@ TclpDlopen(
Tcl_DString ds;
- native = Tcl_UtfToExternalDString(NULL, fileName, TCL_INDEX_NONE, &ds);
+ if (Tcl_UtfToExternalDStringEx(interp, NULL, fileName, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+ native = Tcl_DStringValue(&ds);
lm = (Tcl_LibraryInitProc *) load(native, LDR_NOFLAGS);
Tcl_DStringFree(&ds);
}
@@ -132,8 +137,9 @@ TclpDlopen(
newHandle->clientData = pkg;
newHandle->findSymbolProcPtr = &FindSymbol;
newHandle->unloadFileProcPtr = &UnloadFile;
- *loadHandle = newHandle;
*unloadProcPtr = &UnloadFile;
+ *loadHandle = newHandle;
+
return TCL_OK;
}
@@ -147,7 +153,7 @@ TclpDlopen(
*
* Results:
* Returns a pointer to the function associated with 'symbol' if it is
- * found. Otherwise returns NULL and may leave an error message in the
+ * found. Otherwise returns NULL and may leave an error message in the
* interp's result.
*
*----------------------------------------------------------------------
@@ -159,14 +165,14 @@ FindSymbol(
Tcl_LoadHandle loadHandle,
const char *symbol)
{
- void *retval = ldr_lookup_package((char *) loadHandle, symbol);
+ void *proc = ldr_lookup_package((char *) loadHandle, symbol);
- if (retval == NULL && interp != NULL) {
+ if (proc == NULL && interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"cannot find symbol \"%s\"", symbol));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
}
- return retval;
+ return proc;
}
/*
diff --git a/unix/tclLoadShl.c b/unix/tclLoadShl.c
index 0889c21..63e9328 100644
--- a/unix/tclLoadShl.c
+++ b/unix/tclLoadShl.c
@@ -31,13 +31,13 @@ static void UnloadFile(Tcl_LoadHandle handle);
* to the new code.
*
* Results:
- * A standard Tcl completion code. If an error occurs, an error message
+ * A standard Tcl completion code. If an error occurs, an error message
* is left in the interp's result.
*
* Side effects:
* New code suddenly appears in memory.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
int
@@ -86,7 +86,11 @@ TclpDlopen(
Tcl_DString ds;
- native = Tcl_UtfToExternalDString(NULL, fileName, TCL_INDEX_NONE, &ds);
+ if (Tcl_UtfToExternalDStringEx(interp, NULL, fileName, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+ native = Tcl_DStringValue(&ds);
handle = shl_load(native, BIND_DEFERRED|BIND_VERBOSE|DYNAMIC_PATH, 0L);
Tcl_DStringFree(&ds);
}
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index dce71c4..3a6f13c 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -759,28 +759,35 @@ TclpObjCopyDirectory(
Tcl_Obj *transPtr;
transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr);
- Tcl_UtfToExternalDStringEx(NULL, NULL,
+ ret = Tcl_UtfToExternalDStringEx(NULL, NULL,
(transPtr != NULL ? TclGetString(transPtr) : NULL),
- -1, TCL_ENCODING_PROFILE_TCL8, &srcString, NULL);
+ -1, 0, &srcString, NULL);
if (transPtr != NULL) {
Tcl_DecrRefCount(transPtr);
}
- transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr);
- Tcl_UtfToExternalDStringEx(NULL, NULL,
+ if (ret != TCL_OK) {
+ *errorPtr = srcPathPtr;
+ } else {
+ transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr);
+ ret = Tcl_UtfToExternalDStringEx(NULL, NULL,
(transPtr != NULL ? TclGetString(transPtr) : NULL),
-1, TCL_ENCODING_PROFILE_TCL8, &dstString, NULL);
- if (transPtr != NULL) {
- Tcl_DecrRefCount(transPtr);
+ if (transPtr != NULL) {
+ Tcl_DecrRefCount(transPtr);
+ }
+ if (ret != TCL_OK) {
+ *errorPtr = destPathPtr;
+ } else {
+ ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds, 0);
+ /* Note above call only sets ds on error */
+ if (ret != TCL_OK) {
+ *errorPtr = Tcl_DStringToObj(&ds);
+ }
+ Tcl_DStringFree(&dstString);
+ }
+ Tcl_DStringFree(&srcString);
}
-
- ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds, 0);
-
- Tcl_DStringFree(&srcString);
- Tcl_DStringFree(&dstString);
-
if (ret != TCL_OK) {
- *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), TCL_INDEX_NONE);
- Tcl_DStringFree(&ds);
Tcl_IncrRefCount(*errorPtr);
}
return ret;
@@ -823,18 +830,24 @@ TclpObjRemoveDirectory(
int ret;
Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
- Tcl_UtfToExternalDStringEx(NULL, NULL,
+ ret = Tcl_UtfToExternalDStringEx(NULL, NULL,
(transPtr != NULL ? TclGetString(transPtr) : NULL),
-1, TCL_ENCODING_PROFILE_TCL8, &pathString, NULL);
if (transPtr != NULL) {
Tcl_DecrRefCount(transPtr);
}
- ret = DoRemoveDirectory(&pathString, recursive, &ds);
- Tcl_DStringFree(&pathString);
+ if (ret != TCL_OK) {
+ *errorPtr = pathPtr;
+ } else {
+ ret = DoRemoveDirectory(&pathString, recursive, &ds);
+ Tcl_DStringFree(&pathString);
+ /* Note above call only sets ds on error */
+ if (ret != TCL_OK) {
+ *errorPtr = Tcl_DStringToObj(&ds);
+ }
+ }
if (ret != TCL_OK) {
- *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), TCL_INDEX_NONE);
- Tcl_DStringFree(&ds);
Tcl_IncrRefCount(*errorPtr);
}
return ret;
@@ -883,7 +896,7 @@ DoRemoveDirectory(
result = TCL_OK;
if ((errno != EEXIST) || (recursive == 0)) {
if (errorPtr != NULL) {
- Tcl_ExternalToUtfDStringEx(NULL, NULL, path, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, errorPtr, NULL);
+ Tcl_ExternalToUtfDStringEx(NULL, NULL, path, TCL_INDEX_NONE, 0, errorPtr, NULL);
}
result = TCL_ERROR;
}
@@ -1132,7 +1145,7 @@ TraverseUnixTree(
end:
if (errfile != NULL) {
if (errorPtr != NULL) {
- Tcl_ExternalToUtfDStringEx(NULL, NULL, errfile, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, errorPtr, NULL);
+ Tcl_ExternalToUtfDStringEx(NULL, NULL, errfile, TCL_INDEX_NONE, 0, errorPtr, NULL);
}
result = TCL_ERROR;
}
@@ -1203,7 +1216,7 @@ TraversalCopy(
if (errorPtr != NULL) {
Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(dstPtr),
- Tcl_DStringLength(dstPtr), TCL_ENCODING_PROFILE_TCL8, errorPtr, NULL);
+ Tcl_DStringLength(dstPtr), 0, errorPtr, NULL);
}
return TCL_ERROR;
}
@@ -1254,7 +1267,7 @@ TraversalDelete(
}
if (errorPtr != NULL) {
Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(srcPtr),
- Tcl_DStringLength(srcPtr), TCL_ENCODING_PROFILE_TCL8, errorPtr, NULL);
+ Tcl_DStringLength(srcPtr), 0, errorPtr, NULL);
}
return TCL_ERROR;
}
@@ -1421,7 +1434,7 @@ GetOwnerAttribute(
} else {
Tcl_DString ds;
- Tcl_ExternalToUtfDStringEx(NULL, NULL, pwPtr->pw_name, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &ds, NULL);
+ (void)Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, TCL_INDEX_NONE, &ds);
*attributePtrPtr = Tcl_DStringToObj(&ds);
}
return TCL_OK;
@@ -1505,7 +1518,11 @@ SetGroupAttribute(
string = Tcl_GetStringFromObj(attributePtr, &length);
- native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
+ if (Tcl_UtfToExternalDStringEx(interp, NULL, string, length, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+ native = Tcl_DStringValue(&ds);
groupPtr = TclpGetGrNam(native); /* INTL: Native. */
Tcl_DStringFree(&ds);
@@ -1572,7 +1589,11 @@ SetOwnerAttribute(
string = Tcl_GetStringFromObj(attributePtr, &length);
- native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
+ if (Tcl_UtfToExternalDStringEx(interp, NULL, string, length, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+ native = Tcl_DStringValue(&ds);
pwPtr = TclpGetPwNam(native); /* INTL: Native. */
Tcl_DStringFree(&ds);
@@ -1932,7 +1953,7 @@ GetModeFromPermString(
int
TclpObjNormalizePath(
- TCL_UNUSED(Tcl_Interp *),
+ Tcl_Interp *interp,
Tcl_Obj *pathPtr, /* An unshared object containing the path to
* normalize. */
int nextCheckpoint) /* offset to start at in pathPtr. Must either
@@ -1966,8 +1987,12 @@ TclpObjNormalizePath(
const char *lastDir = strrchr(currentPathEndPosition, '/');
if (lastDir != NULL) {
- nativePath = Tcl_UtfToExternalDString(NULL, path,
- lastDir-path, &ds);
+ if (Tcl_UtfToExternalDStringEx(interp, NULL, path,
+ lastDir-path, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return -1;
+ }
+ nativePath = Tcl_DStringValue(&ds);
if (Realpath(nativePath, normPath) != NULL) {
if (*nativePath != '/' && *normPath == '/') {
/*
@@ -2002,8 +2027,12 @@ TclpObjNormalizePath(
int accessOk;
- nativePath = Tcl_UtfToExternalDString(NULL, path,
- currentPathEndPosition - path, &ds);
+ if (Tcl_UtfToExternalDStringEx(interp, NULL, path,
+ currentPathEndPosition - path, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return -1;
+ }
+ nativePath = Tcl_DStringValue(&ds);
accessOk = access(nativePath, F_OK);
Tcl_DStringFree(&ds);
@@ -2047,7 +2076,11 @@ TclpObjNormalizePath(
return 0;
}
- nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds);
+ if (Tcl_UtfToExternalDStringEx(interp, NULL, path,nextCheckpoint, 0, &ds, NULL)) {
+ Tcl_DStringFree(&ds);
+ return -1;
+ }
+ nativePath = Tcl_DStringValue(&ds);
if (Realpath(nativePath, normPath) != NULL) {
Tcl_Size newNormLen;
@@ -2083,7 +2116,7 @@ TclpObjNormalizePath(
*/
Tcl_DStringFree(&ds);
- Tcl_ExternalToUtfDStringEx(NULL, NULL, normPath, newNormLen, TCL_ENCODING_PROFILE_TCL8, &ds, NULL);
+ Tcl_ExternalToUtfDStringEx(NULL, NULL, normPath, newNormLen, 0, &ds, NULL);
if (path[nextCheckpoint] != '\0') {
/*
@@ -2171,12 +2204,14 @@ TclUnixOpenTemporaryFile(
Tcl_Size length;
/*
- * We should also check against making more then TMP_MAX of these.
+ * We should also check against making more than TMP_MAX of these.
*/
if (dirObj) {
string = Tcl_GetStringFromObj(dirObj, &length);
- Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, TCL_ENCODING_PROFILE_TCL8, &templ, NULL);
+ if (Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, 0, &templ, NULL) != TCL_OK) {
+ return -1;
+ }
} else {
Tcl_DStringInit(&templ);
Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */
@@ -2186,7 +2221,10 @@ TclUnixOpenTemporaryFile(
if (basenameObj) {
string = Tcl_GetStringFromObj(basenameObj, &length);
- Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, TCL_ENCODING_PROFILE_TCL8, &tmp, NULL);
+ if (Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, 0, &tmp, NULL) != TCL_OK) {
+ Tcl_DStringFree(&tmp);
+ return -1;
+ }
TclDStringAppendDString(&templ, &tmp);
Tcl_DStringFree(&tmp);
} else {
@@ -2198,7 +2236,10 @@ TclUnixOpenTemporaryFile(
#ifdef HAVE_MKSTEMPS
if (extensionObj) {
string = Tcl_GetStringFromObj(extensionObj, &length);
- Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, TCL_ENCODING_PROFILE_TCL8, &tmp, NULL);
+ if (Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, 0, &tmp, NULL) != TCL_OK) {
+ Tcl_DStringFree(&templ);
+ return -1;
+ }
TclDStringAppendDString(&templ, &tmp);
fd = mkstemps(Tcl_DStringValue(&templ), Tcl_DStringLength(&tmp));
Tcl_DStringFree(&tmp);
@@ -2214,8 +2255,11 @@ TclUnixOpenTemporaryFile(
}
if (resultingNameObj) {
- Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&templ),
- Tcl_DStringLength(&templ), TCL_ENCODING_PROFILE_TCL8, &tmp, NULL);
+ if (Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&templ),
+ Tcl_DStringLength(&templ), 0, &tmp, NULL) != TCL_OK) {
+ Tcl_DStringFree(&templ);
+ return -1;
+ }
Tcl_SetStringObj(resultingNameObj, Tcl_DStringValue(&tmp),
Tcl_DStringLength(&tmp));
Tcl_DStringFree(&tmp);
@@ -2301,7 +2345,9 @@ TclpCreateTemporaryDirectory(
if (dirObj) {
string = TclGetString(dirObj);
- Tcl_UtfToExternalDStringEx(NULL, NULL, string, dirObj->length, TCL_ENCODING_PROFILE_TCL8, &templ, NULL);
+ if (Tcl_UtfToExternalDStringEx(NULL, NULL, string, dirObj->length, 0, &templ, NULL) != TCL_OK) {
+ return NULL;
+ }
} else {
Tcl_DStringInit(&templ);
Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */
@@ -2314,7 +2360,10 @@ TclpCreateTemporaryDirectory(
if (basenameObj) {
string = TclGetString(basenameObj);
if (basenameObj->length) {
- Tcl_UtfToExternalDStringEx(NULL, NULL, string, basenameObj->length, TCL_ENCODING_PROFILE_TCL8, &tmp, NULL);
+ if (Tcl_UtfToExternalDStringEx(NULL, NULL, string, basenameObj->length, 0, &tmp, NULL) != TCL_OK) {
+ Tcl_DStringFree(&templ);
+ return NULL;
+ }
TclDStringAppendDString(&templ, &tmp);
Tcl_DStringFree(&tmp);
} else {
@@ -2339,8 +2388,11 @@ TclpCreateTemporaryDirectory(
* The template has been updated. Tell the caller what it was.
*/
- Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&templ),
- Tcl_DStringLength(&templ), TCL_ENCODING_PROFILE_TCL8, &tmp, NULL);
+ if (Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&templ),
+ Tcl_DStringLength(&templ), 0, &tmp, NULL) != TCL_OK) {
+ Tcl_DStringFree(&templ);
+ return NULL;
+ }
Tcl_DStringFree(&templ);
return Tcl_DStringToObj(&tmp);
}
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 8606960..42be6bc 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -308,7 +308,13 @@ TclpMatchInDirectory(
* Now open the directory for reading and iterate over the contents.
*/
- native = Tcl_UtfToExternalDString(NULL, dirName, TCL_INDEX_NONE, &ds);
+ if (Tcl_UtfToExternalDStringEx(interp, NULL, dirName, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&dsOrig);
+ Tcl_DStringFree(&ds);
+ Tcl_DecrRefCount(fileNamePtr);
+ return TCL_ERROR;
+ }
+ native = Tcl_DStringValue(&ds);
if ((TclOSstat(native, &statBuf) != 0) /* INTL: Native. */
|| !S_ISDIR(statBuf.st_mode)) {
@@ -372,8 +378,12 @@ TclpMatchInDirectory(
* and pattern. If so, add the file to the result.
*/
- utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, TCL_INDEX_NONE,
- &utfDs);
+ if (Tcl_ExternalToUtfDStringEx(interp, NULL, entryPtr->d_name, TCL_INDEX_NONE,
+ 0, &utfDs, NULL) != TCL_OK) {
+ matchResult = -1;
+ break;
+ }
+ utfname = Tcl_DStringValue(&utfDs);
if (Tcl_StringCaseMatch(utfname, pattern, 0)) {
int typeOk = 1;
@@ -599,7 +609,13 @@ TclpGetUserHome(
{
struct passwd *pwPtr;
Tcl_DString ds;
- const char *native = Tcl_UtfToExternalDString(NULL, name, TCL_INDEX_NONE, &ds);
+ const char *native;
+
+ if (Tcl_UtfToExternalDStringEx(NULL, NULL, name, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return NULL;
+ }
+ native = Tcl_DStringValue(&ds);
pwPtr = TclpGetPwNam(native); /* INTL: Native. */
Tcl_DStringFree(&ds);
@@ -607,7 +623,11 @@ TclpGetUserHome(
if (pwPtr == NULL) {
return NULL;
}
- return Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, TCL_INDEX_NONE, bufferPtr);
+ if (Tcl_ExternalToUtfDStringEx(NULL, NULL, pwPtr->pw_dir, TCL_INDEX_NONE, 0, bufferPtr, NULL) != TCL_OK) {
+ return NULL;
+ } else {
+ return Tcl_DStringValue(bufferPtr);
+ }
}
/*
@@ -785,7 +805,10 @@ TclpGetCwd(
}
return NULL;
}
- return Tcl_ExternalToUtfDString(NULL, buffer, TCL_INDEX_NONE, bufferPtr);
+ if (Tcl_ExternalToUtfDStringEx(interp, NULL, buffer, TCL_INDEX_NONE, 0, bufferPtr, NULL) != TCL_OK) {
+ return NULL;
+ }
+ return Tcl_DStringValue(bufferPtr);
}
/*
@@ -816,11 +839,15 @@ TclpReadlink(
{
#ifndef DJGPP
char link[MAXPATHLEN];
- ssize_t length;
+ Tcl_Size length;
const char *native;
Tcl_DString ds;
- native = Tcl_UtfToExternalDString(NULL, path, TCL_INDEX_NONE, &ds);
+ if (Tcl_UtfToExternalDStringEx(NULL, NULL, path, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return NULL;
+ }
+ native = Tcl_DStringValue(&ds);
length = readlink(native, link, sizeof(link)); /* INTL: Native. */
Tcl_DStringFree(&ds);
@@ -828,11 +855,12 @@ TclpReadlink(
return NULL;
}
- Tcl_ExternalToUtfDStringEx(NULL, NULL, link, (size_t)length, TCL_ENCODING_PROFILE_TCL8, linkPtr, NULL);
- return Tcl_DStringValue(linkPtr);
-#else
- return NULL;
+ if (Tcl_ExternalToUtfDStringEx(NULL, NULL, link, length, 0, linkPtr, NULL) == TCL_OK) {
+ return Tcl_DStringValue(linkPtr);
+ }
#endif /* !DJGPP */
+
+ return NULL;
}
/*
@@ -962,7 +990,11 @@ TclpObjLink(
return NULL;
}
target = Tcl_GetStringFromObj(transPtr, &length);
- target = Tcl_UtfToExternalDString(NULL, target, length, &ds);
+ if (Tcl_UtfToExternalDStringEx(NULL, NULL, target, length, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return NULL;
+ }
+ target = Tcl_DStringValue(&ds);
Tcl_DecrRefCount(transPtr);
if (symlink(target, src) != 0) {
@@ -997,7 +1029,9 @@ TclpObjLink(
return NULL;
}
- Tcl_ExternalToUtfDStringEx(NULL, NULL, link, (size_t)length, TCL_ENCODING_PROFILE_TCL8, &ds, NULL);
+ if (Tcl_ExternalToUtfDStringEx(NULL, NULL, link, (size_t)length, 0, &ds, NULL) != TCL_OK) {
+ return NULL;
+ }
linkPtr = Tcl_DStringToObj(&ds);
Tcl_IncrRefCount(linkPtr);
return linkPtr;
@@ -1116,7 +1150,11 @@ TclNativeCreateNativeRep(
}
str = Tcl_GetStringFromObj(validPathPtr, &len);
- Tcl_UtfToExternalDStringEx(NULL, NULL, str, len, TCL_ENCODING_PROFILE_TCL8, &ds, NULL);
+ if (Tcl_UtfToExternalDStringEx(NULL, NULL, str, len, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DecrRefCount(validPathPtr);
+ Tcl_DStringFree(&ds);
+ return NULL;
+ }
len = Tcl_DStringLength(&ds) + sizeof(char);
if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) {
/* See bug [3118489]: NUL in filenames */
diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c
index 4e8a758..8c0b378 100644
--- a/unix/tclUnixPipe.c
+++ b/unix/tclUnixPipe.c
@@ -152,7 +152,11 @@ TclpOpenFile(
const char *native;
Tcl_DString ds;
- native = Tcl_UtfToExternalDString(NULL, fname, TCL_INDEX_NONE, &ds);
+ if (Tcl_UtfToExternalDStringEx(NULL, NULL, fname, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ return NULL;
+ }
+ native = Tcl_DStringValue(&ds);
fd = TclOSopen(native, mode, 0666); /* INTL: Native. */
Tcl_DStringFree(&ds);
if (fd != -1) {
@@ -209,7 +213,12 @@ TclpCreateTempFile(
Tcl_DString dstring;
char *native;
- native = Tcl_UtfToExternalDString(NULL, contents, TCL_INDEX_NONE, &dstring);
+ if (Tcl_UtfToExternalDStringEx(NULL, NULL, contents, TCL_INDEX_NONE, 0, &dstring, NULL) != TCL_OK) {
+ close(fd);
+ Tcl_DStringFree(&dstring);
+ return NULL;
+ }
+ native = Tcl_DStringValue(&dstring);
if (write(fd, native, Tcl_DStringLength(&dstring)) == -1) {
close(fd);
Tcl_DStringFree(&dstring);
@@ -452,7 +461,15 @@ TclpCreateProcess(
newArgv = (char **)TclStackAlloc(interp, (argc+1) * sizeof(char *));
newArgv[argc] = NULL;
for (i = 0; i < argc; i++) {
- newArgv[i] = Tcl_UtfToExternalDString(NULL, argv[i], TCL_INDEX_NONE, &dsArray[i]);
+ if (Tcl_UtfToExternalDStringEx(interp, NULL, argv[i], TCL_INDEX_NONE, 0, &dsArray[i], NULL) != TCL_OK) {
+ while (i-- > 0) {
+ Tcl_DStringFree(&dsArray[i]);
+ }
+ TclStackFree(interp, newArgv);
+ TclStackFree(interp, dsArray);
+ goto error;
+ }
+ newArgv[i] = Tcl_DStringValue(&dsArray[i]);
}
#if defined(HAVE_VFORK) || defined(HAVE_POSIX_SPAWNP)
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index d9cee73..fd183cf 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -651,7 +651,7 @@ TclpCreateTempFile(
const char *contents) /* String to write into temp file, or NULL. */
{
WCHAR name[MAX_PATH];
- const char *native;
+ const char *native = NULL;
Tcl_DString dstring;
HANDLE handle;
@@ -679,7 +679,10 @@ TclpCreateTempFile(
* Convert the contents from UTF to native encoding
*/
- native = Tcl_UtfToExternalDString(NULL, contents, TCL_INDEX_NONE, &dstring);
+ if (Tcl_UtfToExternalDStringEx(NULL, TCLFSENCODING, contents, TCL_INDEX_NONE, 0, &dstring, NULL) != TCL_OK) {
+ goto error;
+ }
+ native = Tcl_DStringValue(&dstring);
toCopy = Tcl_DStringLength(&dstring);
for (p = native; toCopy > 0; p++, toCopy--) {
@@ -719,7 +722,9 @@ TclpCreateTempFile(
Tcl_DStringFree(&dstring);
}
- Tcl_WinConvertError(GetLastError());
+ if (native != NULL) {
+ Tcl_WinConvertError(GetLastError());
+ }
CloseHandle(handle);
DeleteFileW(name);
return NULL;