Index: doc/CrtChannel.3 ================================================================== --- doc/CrtChannel.3 +++ doc/CrtChannel.3 @@ -13,11 +13,11 @@ .SH SYNOPSIS .nf \fB#include \fR .sp Tcl_Channel -\fBTcl_CreateChannel\fR(\fItypePtr, channelName, instanceData, mask\fR) +\fBTcl_CreateChannel\fR(\fItypePtr, channelName, instanceData, flags\fR) .sp void * \fBTcl_GetChannelInstanceData\fR(\fIchannel\fR) .sp const Tcl_ChannelType * @@ -128,13 +128,15 @@ of the standard channels (\fBstdin\fR, \fBstdout\fR or \fBstderr\fR), the assigned channel name will be the name of the standard channel. .AP void *instanceData in Arbitrary one-word value to be associated with this channel. This value is passed to procedures in \fItypePtr\fR when they are invoked. -.AP int mask in +.AP int flags in OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR to indicate -whether a channel is readable and writable. +whether a channel is readable and writable. Can also be combined with +one of \fBTCL_ENCODING_PROFILE_STRICT\fR, \fBTCL_ENCODING_PROFILE_TCL8\fR, +or \fBTCL_ENCODING_PROFILE_REPLACE\fR. .AP Tcl_Channel channel in The channel to operate on. .AP int direction in \fBTCL_READABLE\fR means the input handle is wanted; \fBTCL_WRITABLE\fR means the output handle is wanted. @@ -198,11 +200,11 @@ The generic layer will then invoke the functions referenced in that structure to perform operations on the channel. .PP \fBTcl_CreateChannel\fR opens a new channel and associates the supplied \fItypePtr\fR and \fIinstanceData\fR with it. The channel is opened in the -mode indicated by \fImask\fR. +mode indicated by \fIflags\fR. For a discussion of channel drivers, their operations and the \fBTcl_ChannelType\fR structure, see the section \fBTCL_CHANNELTYPE\fR, below. .PP \fBTcl_CreateChannel\fR interacts with the code managing the standard channels. Once a standard channel was initialized either through a Index: doc/OpenFileChnl.3 ================================================================== --- doc/OpenFileChnl.3 +++ doc/OpenFileChnl.3 @@ -19,11 +19,11 @@ .sp Tcl_Channel \fBTcl_OpenCommandChannel\fR(\fIinterp, argc, argv, flags\fR) .sp Tcl_Channel -\fBTcl_MakeFileChannel\fR(\fIhandle, readOrWrite\fR) +\fBTcl_MakeFileChannel\fR(\fIhandle, mask\fR) .sp Tcl_Channel \fBTcl_GetChannel\fR(\fIinterp, channelName, modePtr\fR) .sp int @@ -135,13 +135,15 @@ \fBTCL_STDIN\fR, \fBTCL_STDOUT\fR and \fBTCL_STDERR\fR have been set. If it is set, then such redirections cause an error. .AP void *handle in Operating system specific handle for I/O to a file. For Unix this is a file descriptor, for Windows it is a HANDLE. -.AP int readOrWrite in +.AP int mask in OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR to indicate -what operations are valid on \fIhandle\fR. +what operations are valid on \fIhandle\fR. Can also be combined with +one of \fBTCL_ENCODING_PROFILE_STRICT\fR, \fBTCL_ENCODING_PROFILE_TCL8\fR, +or \fBTCL_ENCODING_PROFILE_REPLACE\fR. .AP "const char" *channelName in The name of the channel. .AP int *modePtr out Points at an integer variable that will receive an OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR denoting whether the channel is Index: doc/encoding.n ================================================================== --- doc/encoding.n +++ doc/encoding.n @@ -111,11 +111,12 @@ 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 +The default profile, unless the environment variable \fBTCL_PROFILE_DEFAULT\fR +is set to either "tcl8" or "replace". The operation fails when invalid data for the encoding are encountered. .TP \fBtcl8\fR . Provides for behaviour identical to that of Tcl 8.6: When Index: generic/tclBasic.c ================================================================== --- generic/tclBasic.c +++ generic/tclBasic.c @@ -881,11 +881,30 @@ iPtr->compileEpoch = 1; iPtr->compiledProcPtr = NULL; iPtr->resolverPtr = NULL; iPtr->evalFlags = 0; iPtr->scriptFile = NULL; - iPtr->flags = 0; + iPtr->flags = TCL_ENCODING_PROFILE_STRICT; +#ifdef _WIN32 + wchar_t *defaultProfile = getenv("TCL_PROFILE_DEFAULT"); + if (defaultProfile != NULL) { + if (!wcscmp(defaultProfile, L"tcl8")) { + iPtr->flags = TCL_ENCODING_PROFILE_TCL8; + } else if (!wcscmp(defaultProfile, L"replace")) { + iPtr->flags = TCL_ENCODING_PROFILE_REPLACE; + } + } +#else + char *defaultProfile = getenv("TCL_PROFILE_DEFAULT"); + if (defaultProfile != NULL) { + if (!strcmp(defaultProfile, "tcl8")) { + iPtr->flags = TCL_ENCODING_PROFILE_TCL8; + } else if (!strcmp(defaultProfile, "replace")) { + iPtr->flags = TCL_ENCODING_PROFILE_REPLACE; + } + } +#endif iPtr->tracePtr = NULL; iPtr->tracesForbiddingInline = 0; iPtr->activeCmdTracePtr = NULL; iPtr->activeInterpTracePtr = NULL; iPtr->assocData = NULL; Index: generic/tclCmdAH.c ================================================================== --- generic/tclCmdAH.c +++ generic/tclCmdAH.c @@ -433,11 +433,11 @@ static const char *const options[] = {"-profile", "-failindex", NULL}; enum convertfromOptions { PROFILE, FAILINDEX } optIndex; Tcl_Encoding encoding; Tcl_Obj *dataObj; Tcl_Obj *failVarObj; - int profile = TCL_ENCODING_PROFILE_STRICT; + int profile = -1; /* * Possible combinations: * 1) data -> objc = 2 * 2) ?options? encoding data -> objc >= 3 @@ -492,10 +492,13 @@ return TCL_ERROR; } dataObj = objv[objc - 1]; } + if (profile == -1) { + profile = ENCODING_PROFILE_GET(((Interp *)interp)->flags); + } *encPtr = encoding; *dataObjPtr = dataObj; *profilePtr = profile; *failVarPtr = failVarObj; Index: generic/tclEncoding.c ================================================================== --- generic/tclEncoding.c +++ generic/tclEncoding.c @@ -4571,10 +4571,11 @@ Tcl_Interp *interp, /* For error messages. May be NULL */ int profileValue) /* Profile #define value */ { size_t i; + profileValue &= ENCODING_PROFILE_MASK; for (i = 0; i < sizeof(encodingProfiles) / sizeof(encodingProfiles[0]); ++i) { if (profileValue == encodingProfiles[i].value) { return encodingProfiles[i].name; } } Index: generic/tclFCmd.c ================================================================== --- generic/tclFCmd.c +++ generic/tclFCmd.c @@ -10,10 +10,11 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclFileSystem.h" +#include "tclIO.h" /* * Declarations for local functions defined in this file: */ @@ -1455,10 +1456,12 @@ * Create and open the temporary file. */ makeTemporary: chan = TclpOpenTemporaryFile(tempDirObj,tempBaseObj,tempExtObj, nameObj); + ENCODING_PROFILE_SET(((Channel *)chan)->state->inputEncodingFlags, ((Interp *)interp)->flags); + ENCODING_PROFILE_SET(((Channel *)chan)->state->outputEncodingFlags, ((Interp *)interp)->flags); /* * If we created pieces of template, get rid of them now. */ Index: generic/tclIORChan.c ================================================================== --- generic/tclIORChan.c +++ generic/tclIORChan.c @@ -680,10 +680,13 @@ mode); rcPtr->chan = chan; TclChannelPreserve(chan); chanPtr = (Channel *) chan; + ENCODING_PROFILE_SET(chanPtr->state->inputEncodingFlags, ((Interp *)interp)->flags); + ENCODING_PROFILE_SET(chanPtr->state->outputEncodingFlags, ((Interp *)interp)->flags); + if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) { /* * Some of the nullable methods are not supported. We clone the * channel type, null the associated C functions, and use the result * as the actual channel type. Index: generic/tclInt.h ================================================================== --- generic/tclInt.h +++ generic/tclInt.h @@ -2327,10 +2327,11 @@ * being detected; however, if the TCL_CANCEL_UNWIND flag * is set Tcl_Canceled will continue to report that the * script in progress has been canceled thereby allowing * the evaluation stack for the interp to be fully * unwound. + * Bits 24-32 are reserved to store the default encoding profile. * * WARNING: For the sake of some extensions that have made use of former * internal values, do not re-use the flag values 2 (formerly ERR_IN_PROGRESS) * or 8 (formerly ERROR_CODE_SET). */ @@ -2866,11 +2867,11 @@ #define ENCODING_PROFILE_MASK 0xFF000000 #define ENCODING_PROFILE_GET(flags_) ((flags_) & ENCODING_PROFILE_MASK) #define ENCODING_PROFILE_SET(flags_, profile_) \ do { \ (flags_) &= ~ENCODING_PROFILE_MASK; \ - (flags_) |= profile_; \ + (flags_) |= (profile_) & ENCODING_PROFILE_MASK; \ } while (0) /* *---------------------------------------------------------------- * Variables shared among Tcl modules but not used by the outside world. Index: generic/tclInterp.c ================================================================== --- generic/tclInterp.c +++ generic/tclInterp.c @@ -10,10 +10,11 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" +#include "tclIO.h" /* * A pointer to a string that holds an initialization script that if non-NULL * is evaluated in Tcl_Init() prior to the built-in initialization script * above. This variable can be modified by the function below. @@ -620,12 +621,12 @@ static const char *const options[] = { "alias", "aliases", "bgerror", "cancel", "children", "create", "debug", "delete", "eval", "exists", "expose", "hide", "hidden", "issafe", "invokehidden", - "limit", "marktrusted", "recursionlimit", - "share", + "limit", "marktrusted", "profile", + "recursionlimit", "share", #ifndef TCL_NO_DEPRECATED "slaves", #endif "target", "transfer", NULL }; @@ -632,20 +633,20 @@ static const char *const optionsNoSlaves[] = { "alias", "aliases", "bgerror", "cancel", "children", "create", "debug", "delete", "eval", "exists", "expose", "hide", "hidden", "issafe", - "invokehidden", "limit", "marktrusted", "recursionlimit", - "share", "target", "transfer", + "invokehidden", "limit", "marktrusted", "profile", + "recursionlimit", "share", "target", "transfer", NULL }; enum interpOptionEnum { OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_CANCEL, OPT_CHILDREN, OPT_CREATE, OPT_DEBUG, OPT_DELETE, OPT_EVAL, OPT_EXISTS, OPT_EXPOSE, OPT_HIDE, - OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHID, - OPT_LIMIT, OPT_MARKTRUSTED, OPT_RECLIMIT, OPT_SHARE, + OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHID, OPT_LIMIT, + OPT_MARKTRUSTED, OPT_PROFILE, OPT_RECLIMIT, OPT_SHARE, #ifndef TCL_NO_DEPRECATED OPT_SLAVES, #endif OPT_TARGET, OPT_TRANSFER } index; @@ -1031,10 +1032,25 @@ childInterp = GetInterp(interp, objv[2]); if (childInterp == NULL) { return TCL_ERROR; } return ChildRecursionLimit(interp, childInterp, objc - 3, objv + 3); + case OPT_PROFILE: + if (objc != 2 && objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?profile?"); + return TCL_ERROR; + } + Interp *iPtr = (Interp *)interp; + if (objc == 3) { + int newProfile; + if (TclEncodingProfileNameToId(interp, Tcl_GetString(objv[2]), &newProfile) != TCL_OK) { + return TCL_ERROR; + } + ENCODING_PROFILE_SET(iPtr->flags, newProfile); + } + Tcl_AppendResult(interp, TclEncodingProfileIdToName(NULL, iPtr->flags), NULL); + return TCL_OK; #ifndef TCL_NO_DEPRECATED case OPT_SLAVES: #endif case OPT_CHILDREN: { InterpInfo *iiPtr; Index: tests/cmdAH.test ================================================================== --- tests/cmdAH.test +++ tests/cmdAH.test @@ -305,11 +305,11 @@ # If utf{16,32}-{le,be}, also do utf{16,32} testconvert $id.$enc2.$profile "list \[encoding $converter -profile $profile -failindex idx $enc2 [list $data]\] \[set idx]" [list $result $failidx] } # If this is the default profile, generate a test without specifying profile - if {$profile eq $::encDefaultProfile} { + if {$profile eq "strict"} { testconvert $id.$enc.default "list \[encoding $converter -failindex idx $enc [list $data]\] \[set idx]" [list $result $failidx] if {[set enc2 [endianUtf $enc]] ne ""} { # If utf{16,32}-{le,be}, also do utf{16,32} testconvert $id.$enc2.default "list \[encoding $converter -failindex idx $enc2 [list $data]\] \[set idx]" [list $result $failidx] } Index: tests/encoding.test ================================================================== --- tests/encoding.test +++ tests/encoding.test @@ -820,11 +820,11 @@ } -result Z\xE0\u20AC test encoding-24.16 {Parse valid or invalid utf-8} -constraints testbytestring -body { encoding convertto utf-8 [testbytestring "Z\u4343\x80"] } -returnCodes 1 -result {expected byte sequence but character 1 was '䍃€' (U+004343)} test encoding-24.17 {Parse valid or invalid utf-8} -constraints testbytestring -body { - encoding convertto utf-8 [testbytestring "Z\xE0\x80"] + encoding convertto -profile strict utf-8 [testbytestring "Z\xE0\x80"] } -result "Z\xC3\xA0\xE2\x82\xAC" test encoding-24.18 {Parse valid or invalid utf-8} -constraints testbytestring -body { encoding convertto utf-8 [testbytestring "Z\xE0\x80xxxxxx"] } -result "Z\xC3\xA0\xE2\x82\xACxxxxxx" test encoding-24.19.1 {Parse valid or invalid utf-8} -body { Index: tests/encodingVectors.tcl ================================================================== --- tests/encodingVectors.tcl +++ tests/encodingVectors.tcl @@ -8,11 +8,11 @@ # vectors. # # List of defined encoding profiles set encProfiles {tcl8 strict replace} -set encDefaultProfile strict; # Should reflect the default from implementation +set encDefaultProfile [interp profile] # encValidStrings - Table of valid strings. # # Each row is # The pair should be unique for generated test ids to be unique. Index: tests/interp.test ================================================================== --- tests/interp.test +++ tests/interp.test @@ -30,11 +30,11 @@ test interp-1.1 {options for interp command} -returnCodes error -body { interp } -result {wrong # args: should be "interp cmd ?arg ...?"} test interp-1.2 {options for interp command} -returnCodes error -body { interp frobox -} -result {bad option "frobox": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, share, target, or transfer} +} -result {bad option "frobox": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, profile, recursionlimit, share, target, or transfer} test interp-1.3 {options for interp command} { interp delete } "" test interp-1.4 {options for interp command} -returnCodes error -body { interp delete foo bar @@ -48,17 +48,17 @@ test interp-1.6 {options for interp command} -returnCodes error -body { interp children foo bar zop } -result {wrong # args: should be "interp children ?path?"} test interp-1.7 {options for interp command} -returnCodes error -body { interp hello -} -result {bad option "hello": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, share, target, or transfer} +} -result {bad option "hello": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, profile, recursionlimit, share, target, or transfer} test interp-1.8 {options for interp command} -returnCodes error -body { interp -froboz -} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, share, target, or transfer} +} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, profile, recursionlimit, share, target, or transfer} test interp-1.9 {options for interp command} -returnCodes error -body { interp -froboz -safe -} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, share, target, or transfer} +} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, profile, recursionlimit, share, target, or transfer} test interp-1.10 {options for interp command} -returnCodes error -body { interp target } -result {wrong # args: should be "interp target path alias"} # Part 1: Basic interpreter creation tests: