Attachment "Duoas-patch.2008-11-01.2014.diff" to
ticket [2215022fff]
added by
duoas
2008-11-02 07:21:36.
diff -r tcl/doc/ByteArrObj.3 tcl-modified/doc/ByteArrObj.3
32c32,33
< The array of bytes used to initialize or set a byte-array object.
---
> The array of bytes used to initialize or set a byte-array object. May be NULL
> even if \fIlength\fR is non-zero.
58c59
< UTF-8 characters in the string representation.
---
> UTF-8 characters in the string representation.
68c69,70
< representation.
---
> representation. If \fIbytes\fR is NULL then the new byte array contains
> arbitrary values.
76c78
< invalidates the string representation.
---
> invalidates the string representation.
diff -r tcl/generic/tclBinary.c tcl-modified/generic/tclBinary.c
77c77
< int objc, Tcl_Obj *const objv[]);
---
> int objc, Tcl_Obj *const objv[]);
315,317c315,317
< * value. */
< int length) /* Length of the array of bytes, which must be
< * >= 0. */
---
> value. May be NULL even if length > 0. */
> int length) /* Length of the array of bytes, which must
> be >= 0. */
326a327
> length = (length < 0) ? 0 : length;
330c331,333
< memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
---
> if (bytes && length) {
> memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
> }
596,597c599,600
< * This function is called to create the "binary" Tcl command. See the user
< * documentation for details on what it does.
---
> * This function is called to create the "binary" Tcl command. See the
> * user documentation for details on what it does.
611,613c614,638
< Tcl_Namespace *nsTclPtr, *nsBinPtr, *nsEncPtr, *nsDecPtr;
< Tcl_Command binEnsemble, encEnsemble, decEnsemble;
< Tcl_Obj *binDict, *encDict, *decDict;
---
> const EnsembleImplMap binaryMap[] = {
> { "format", BinaryFormatCmd },
> { "scan", BinaryScanCmd },
> { "encode", NULL },
> { "decode", NULL },
> { NULL }
> };
> const EnsembleImplMap encodeMap[] = {
> { "hex", BinaryEncodeHex, NULL, NULL, (ClientData)HexDigits },
> { "uuencode", BinaryEncode64, NULL, NULL, (ClientData)UueDigits },
> { "base64", BinaryEncode64, NULL, NULL, (ClientData)B64Digits },
> { NULL }
> };
> const EnsembleImplMap decodeMap[] = {
> { "hex", BinaryDecodeHex },
> { "uuencode", BinaryDecodeUu },
> { "base64", BinaryDecode64 },
> { NULL }
> };
>
> Tcl_Command binaryEnsemble;
>
> binaryEnsemble = TclMakeEnsemble( interp, "binary", binaryMap );
> /*encodeEnsemb*/ TclMakeEnsemble( interp, "binary encode", encodeMap );
> /*decodeEnsemb*/ TclMakeEnsemble( interp, "binary decode", decodeMap );
615,693c640
< /*
< * FIX ME: I so ugly - please make me pretty ...
< */
<
< nsTclPtr = Tcl_FindNamespace(interp, "::tcl",
< NULL, TCL_CREATE_NS_IF_UNKNOWN);
< if (nsTclPtr == NULL) {
< Tcl_Panic("unable to find or create ::tcl namespace!");
< }
< nsBinPtr = Tcl_FindNamespace(interp, "::tcl::binary",
< NULL, TCL_CREATE_NS_IF_UNKNOWN);
< if (nsBinPtr == NULL) {
< Tcl_Panic("unable to find or create ::tcl::binary namespace!");
< }
< binEnsemble = Tcl_CreateEnsemble(interp, "::binary",
< nsBinPtr, TCL_ENSEMBLE_PREFIX);
<
< nsEncPtr = Tcl_FindNamespace(interp, "::tcl::binary::encode",
< NULL, TCL_CREATE_NS_IF_UNKNOWN);
< if (nsEncPtr == NULL) {
< Tcl_Panic("unable to find or create ::tcl::binary::encode namespace!");
< }
< encEnsemble = Tcl_CreateEnsemble(interp, "encode",
< nsBinPtr, 0);
<
< nsDecPtr = Tcl_FindNamespace(interp, "::tcl::binary::decode",
< NULL, TCL_CREATE_NS_IF_UNKNOWN);
< if (nsDecPtr == NULL) {
< Tcl_Panic("unable to find or create ::tcl::binary::decode namespace!");
< }
< decEnsemble = Tcl_CreateEnsemble(interp, "decode",
< nsBinPtr, 0);
<
< TclNewObj(binDict);
< Tcl_DictObjPut(NULL, binDict, Tcl_NewStringObj("format",-1),
< Tcl_NewStringObj("::tcl::binary::format",-1));
< Tcl_DictObjPut(NULL, binDict, Tcl_NewStringObj("scan",-1),
< Tcl_NewStringObj("::tcl::binary::scan",-1));
< Tcl_DictObjPut(NULL, binDict, Tcl_NewStringObj("encode",-1),
< Tcl_NewStringObj("::tcl::binary::encode",-1));
< Tcl_DictObjPut(NULL, binDict, Tcl_NewStringObj("decode",-1),
< Tcl_NewStringObj("::tcl::binary::decode",-1));
< Tcl_CreateObjCommand(interp, "::tcl::binary::format",
< BinaryFormatCmd, NULL, NULL);
< Tcl_CreateObjCommand(interp, "::tcl::binary::scan",
< BinaryScanCmd, NULL, NULL);
< Tcl_SetEnsembleMappingDict(interp, binEnsemble, binDict);
<
< TclNewObj(encDict);
< Tcl_DictObjPut(NULL, encDict, Tcl_NewStringObj("hex",-1),
< Tcl_NewStringObj("::tcl::binary::encode::hex",-1));
< Tcl_DictObjPut(NULL, encDict, Tcl_NewStringObj("uuencode",-1),
< Tcl_NewStringObj("::tcl::binary::encode::uuencode",-1));
< Tcl_DictObjPut(NULL, encDict, Tcl_NewStringObj("base64",-1),
< Tcl_NewStringObj("::tcl::binary::encode::base64",-1));
< Tcl_CreateObjCommand(interp, "::tcl::binary::encode::hex",
< BinaryEncodeHex, (ClientData)HexDigits, NULL);
< Tcl_CreateObjCommand(interp, "::tcl::binary::encode::uuencode",
< BinaryEncode64, (ClientData)UueDigits, NULL);
< Tcl_CreateObjCommand(interp, "::tcl::binary::encode::base64",
< BinaryEncode64, (ClientData)B64Digits, NULL);
< Tcl_SetEnsembleMappingDict(interp, encEnsemble, encDict);
<
< TclNewObj(decDict);
< Tcl_DictObjPut(NULL, decDict, Tcl_NewStringObj("hex",-1),
< Tcl_NewStringObj("::tcl::binary::decode::hex",-1));
< Tcl_DictObjPut(NULL, decDict, Tcl_NewStringObj("uuencode",-1),
< Tcl_NewStringObj("::tcl::binary::decode::uuencode",-1));
< Tcl_DictObjPut(NULL, decDict, Tcl_NewStringObj("base64",-1),
< Tcl_NewStringObj("::tcl::binary::decode::base64",-1));
< Tcl_CreateObjCommand(interp, "::tcl::binary::decode::hex",
< BinaryDecodeHex, (ClientData)NULL, NULL);
< Tcl_CreateObjCommand(interp, "::tcl::binary::decode::uuencode",
< BinaryDecodeUu, (ClientData)NULL, NULL);
< Tcl_CreateObjCommand(interp, "::tcl::binary::decode::base64",
< BinaryDecode64, (ClientData)NULL, NULL);
< Tcl_SetEnsembleMappingDict(interp, decEnsemble, decDict);
<
< return binEnsemble;
---
> return binaryEnsemble;
2712a2660
>
diff -r tcl/generic/tclInt.h tcl-modified/generic/tclInt.h
1458,1461c1458,1465
< const char *name; /* The name of the subcommand. */
< Tcl_ObjCmdProc *proc; /* The implementation of the subcommand. */
< CompileProc *compileProc; /* The compiler for the subcommand. */
< Tcl_ObjCmdProc *nreProc; /* NRE implementation of this command */
---
> const char *name; /* The name of the subcommand */
> Tcl_ObjCmdProc *proc; /* The implementation of the subcommand */
> CompileProc *compileProc; /* The compiler for the subcommand */
> Tcl_ObjCmdProc *nreProc; /* NRE implementation of this command */
> ClientData clientData; /* Any clientData to give the command */
> #if 0
> Tcl_CmdDeleteProc *deleteProc; /* The command's delete proc */
> #endif
4185a4190
>
diff -r tcl/generic/tclNamesp.c tcl-modified/generic/tclNamesp.c
6129a6130,6162
> * The ensemble name may be a top-level command, like "binary".
> *
> * Top-level commands are placed in the global namespace and the
> * ensemble sub-command procedures are placed in the ::tcl::$name
> * namespace. For the 'binary' command and its 'format', 'scan', etc
> * sub-commands, the following commands are created:
> * ::binary
> * ::tcl::binary::format
> * ::tcl::binary::scan
> * ::tcl::binary::encode
> * ::tcl::binary::decode
> *
> * The ensemble name may be a nested ensemble command, like
> * "binary encode".
> *
> * Nested commands are placed in their proper nested-namespace
> * places (where they belong). For example, the 'binary encode'
> * nested ensemble command and its 'hex', 'uuencode', and 'base64'
> * sub-commands names are:
> * ::tcl::binary::encode
> * ::tcl::binary::encode::hex
> * ::tcl::binary::encode::uuencode
> * ::tcl::binary::encode::base64
> *
> * Additional notes:
> * Currently, the TCL_ENSEMBLE_PREFIX ensemble flag is only used on
> * top-level ensemble commands. That is the way the 'binary' command
> * was originally encoded...
> *
> * The EnsembleImplMap currently has the Tcl_CmdDeleteProc item
> * commented-out --I don't think it is ever used in core commands. Hence,
> * it is commented out below as well...
> *
6131c6164
< * Handle for the ensemble, or NULL if creation of it fails.
---
> * Handle for the new ensemble, or NULL on failure.
6134c6167
< * May advance bytecode compilation epoch.
---
> * May advance the bytecode compilation epoch.
6141,6143c6174,6176
< Tcl_Interp *interp,
< const char *name,
< const EnsembleImplMap map[])
---
> Tcl_Interp *interp,
> const char *name, /* The ensemble name (as explained above) */
> const EnsembleImplMap map[]) /* The subcommands to create */
6145,6152c6178,6213
< Tcl_Command ensemble; /* The overall ensemble. */
< Tcl_Namespace *tclNsPtr; /* Reference to the "::tcl" namespace. */
< Tcl_DString buf;
<
< tclNsPtr = Tcl_FindNamespace(interp, "::tcl", NULL,
< TCL_CREATE_NS_IF_UNKNOWN);
< if (tclNsPtr == NULL) {
< Tcl_Panic("unable to find or create ::tcl namespace!");
---
> Tcl_Command ensemble; /* The function result */
> Tcl_Namespace *ns; /* New/sub-command parent namespace */
> Tcl_Obj *nsNameObj; /* Ensemble namespace and cmd name prefix */
> const char *nsName; /* == Tcl_GetString( nsNameObj ) */
> const char *currName; /* used to manipulate the full ns name */
> const char *nextName; /* ditto */
> int length; /* ditto */
> int nameCount; /* n == 1: top-level; n > 1: nested cmd */
> int ensembleFlags = 0; /* See notes above; compile flag */
>
> /* Some validation against empty names */
> if (!name || !name[0] || strspn( name, " \t" ) == strlen( name )) {
> Tcl_Panic( "TclMakeEnsemble: 'name' argument not specified!" );
> }
>
> /* Collect the argument ensemble command into a complete namespace name. */
> nsNameObj = Tcl_NewStringObj( "::tcl", 5 );
> Tcl_IncrRefCount( nsNameObj );
> nextName = name;
> nameCount = 0;
> do {
> nameCount++;
> currName = nextName +strspn( nextName, " \t" );
> nextName = strpbrk( currName, " \t" );
> length = (nextName == NULL) ? -1 : (nextName - currName);
>
> Tcl_AppendToObj( nsNameObj, "::", 2 );
> Tcl_AppendToObj( nsNameObj, currName, length );
>
> } while (nextName);
> nsName = Tcl_GetString( nsNameObj );
>
> /* Create the ensemble's namespace */
> ns = Tcl_FindNamespace( interp, nsName, NULL, TCL_CREATE_NS_IF_UNKNOWN );
> if (!ns) {
> Tcl_Panic( "unable to find or create %s namespace!", nsName );
6154,6161c6215,6222
< Tcl_DStringInit(&buf);
< Tcl_DStringAppend(&buf, "::tcl::", -1);
< Tcl_DStringAppend(&buf, name, -1);
< tclNsPtr = Tcl_FindNamespace(interp, Tcl_DStringValue(&buf), NULL,
< TCL_CREATE_NS_IF_UNKNOWN);
< if (tclNsPtr == NULL) {
< Tcl_Panic("unable to find or create %s namespace!",
< Tcl_DStringValue(&buf));
---
>
> /* Create the ensemble itself in the correct namespace */
> currName = nsName + strlen( nsName ) - strlen( currName );
> if (nameCount == 1) {
> ensembleFlags = TCL_ENSEMBLE_PREFIX;
> currName -= 2;
> } else {
> ns = ns->parentPtr;
6163,6190c6224,6266
< ensemble = Tcl_CreateEnsemble(interp, Tcl_DStringValue(&buf)+5, tclNsPtr,
< TCL_ENSEMBLE_PREFIX);
< Tcl_DStringAppend(&buf, "::", -1);
< if (ensemble != NULL) {
< Tcl_Obj *mapDict;
< int i, compile = 0;
<
< TclNewObj(mapDict);
< for (i=0 ; map[i].name != NULL ; i++) {
< Tcl_Obj *fromObj, *toObj;
< register Command *cmdPtr;
<
< fromObj = Tcl_NewStringObj(map[i].name, -1);
< TclNewStringObj(toObj, Tcl_DStringValue(&buf),
< Tcl_DStringLength(&buf));
< Tcl_AppendToObj(toObj, map[i].name, -1);
< Tcl_DictObjPut(NULL, mapDict, fromObj, toObj);
< cmdPtr = (Command *) Tcl_CreateObjCommand(interp,
< TclGetString(toObj), map[i].proc, NULL, NULL);
< cmdPtr->compileProc = map[i].compileProc;
< cmdPtr->nreProc = map[i].nreProc;
< compile |= (map[i].compileProc != NULL);
< }
< Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
< if (compile) {
< Tcl_SetEnsembleFlags(interp, ensemble,
< TCL_ENSEMBLE_PREFIX | ENSEMBLE_COMPILE);
< }
---
> ensemble = Tcl_CreateEnsemble( interp, currName, ns, ensembleFlags );
>
> /*
> * Create the ensemble mapping dictionary
> * Create the ensemble command procs
> */
> if (ensemble) {
> Tcl_Obj *dict;
> int n;
>
> /* nsName := Prefix for all command names */
> Tcl_AppendToObj( nsNameObj, "::", 2 );
> nsName = Tcl_GetString( nsNameObj );
>
> dict = Tcl_NewDictObj();
> for (n = 0; map[n].name; n++) {
>
> register Command *command;
>
> /* The command name mapping */
> register Tcl_Obj *nameKey = Tcl_NewStringObj( map[n].name, -1 );
> register Tcl_Obj *nameValue = Tcl_NewStringObj( nsName, -1 );
> Tcl_AppendToObj( nameValue, map[n].name, -1 );
>
> Tcl_DictObjPut( NULL, dict, nameKey, nameValue );
>
> /* Add the actual Tcl command itself to the interpreter */
> if (map[n].proc) {
> command = (Command *)Tcl_CreateObjCommand( interp,
> Tcl_GetString( nameValue ),
> map[n].proc, map[n].clientData, /* map[n].deleteProc
> */ NULL );
> command->compileProc = map[n].compileProc;
> command->nreProc = map[n].nreProc;
> ensembleFlags |=
> (command->compileProc != NULL) ? ENSEMBLE_COMPILE : 0;
> }
> }
> Tcl_SetEnsembleMappingDict( interp, ensemble, dict );
>
> if (ensembleFlags & ENSEMBLE_COMPILE) {
> Tcl_SetEnsembleFlags( interp, ensemble, ensembleFlags );
> }
6192c6268,6269
< Tcl_DStringFree(&buf);
---
>
> Tcl_DecrRefCount( nsNameObj );
