diff options
Diffstat (limited to 'generic/tclOOBasic.c')
-rw-r--r-- | generic/tclOOBasic.c | 23 |
1 files changed, 19 insertions, 4 deletions
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 8cb80e5..798bad4 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,7 +1205,7 @@ TclOOCopyObjectCmd( if (objc == 2) { o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, NULL, NULL); } else { - const char *name; + const char *name, *namespaceName; Tcl_DString buffer; name = TclGetString(objv[2]); @@ -1220,7 +1221,21 @@ TclOOCopyObjectCmd( Tcl_DStringAppend(&buffer, name, -1); name = Tcl_DStringValue(&buffer); } - o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, NULL); + + /* Choose a unique namespace name if the user didn't supply one */ + namespaceName = NULL; + + if (objc == 4) { + namespaceName = TclGetString(objv[3]); + + if (Tcl_FindNamespace(interp, namespaceName, NULL, 0) != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s refers to an existing namespace", namespaceName)); + return TCL_ERROR; + } + } + + o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, namespaceName); Tcl_DStringFree(&buffer); } |