diff options
Diffstat (limited to 'generic/tclOOBasic.c')
| -rw-r--r-- | generic/tclOOBasic.c | 39 |
1 files changed, 24 insertions, 15 deletions
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 8cb80e5..d874cba 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -1183,8 +1183,9 @@ TclOOCopyObjectCmd( { Tcl_Object oPtr, o2Ptr; - if (objc < 2 || objc > 3) { - Tcl_WrongNumArgs(interp, 1, objv, "sourceName ?targetName?"); + if (objc < 2 || objc > 4) { + Tcl_WrongNumArgs(interp, 1, objv, + "sourceName ?targetName? ?targetNamespace?"); return TCL_ERROR; } @@ -1204,24 +1205,32 @@ TclOOCopyObjectCmd( if (objc == 2) { o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, NULL, NULL); } else { - const char *name; - Tcl_DString buffer; + const char *name, *namespaceName; name = TclGetString(objv[2]); - Tcl_DStringInit(&buffer); - if (name[0]!=':' || name[1]!=':') { - Interp *iPtr = (Interp *) interp; + if (name[0] == '\0') { + name = NULL; + } + + /* + * Choose a unique namespace name if the user didn't supply one. + */ - if (iPtr->varFramePtr != NULL) { - Tcl_DStringAppend(&buffer, - iPtr->varFramePtr->nsPtr->fullName, -1); + namespaceName = NULL; + if (objc == 4) { + namespaceName = TclGetString(objv[3]); + + if (namespaceName[0] == '\0') { + namespaceName = NULL; + } else if (Tcl_FindNamespace(interp, namespaceName, NULL, + 0) != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s refers to an existing namespace", namespaceName)); + return TCL_ERROR; } - TclDStringAppendLiteral(&buffer, "::"); - Tcl_DStringAppend(&buffer, name, -1); - name = Tcl_DStringValue(&buffer); } - o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, NULL); - Tcl_DStringFree(&buffer); + + o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, namespaceName); } if (o2Ptr == NULL) { |