diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2017-06-22 22:02:14 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2017-06-22 22:02:14 (GMT) |
commit | 4bcc67eec81872423901389198828d4679d7777d (patch) | |
tree | 75978d66c00cf1568200a109c6824a4c2a8b56bb /generic/tclOOBasic.c | |
parent | 4c7792803aef1af6855d09024b037dc190bc249f (diff) | |
parent | 78b1275a4aa81d3b173e4834b73373aa8ebe4ec3 (diff) | |
download | tcl-4bcc67eec81872423901389198828d4679d7777d.zip tcl-4bcc67eec81872423901389198828d4679d7777d.tar.gz tcl-4bcc67eec81872423901389198828d4679d7777d.tar.bz2 |
Implement TIP #473: Allow a Defined Target Namespace in oo::copy
Diffstat (limited to 'generic/tclOOBasic.c')
-rw-r--r-- | generic/tclOOBasic.c | 32 |
1 files changed, 27 insertions, 5 deletions
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 8cb80e5..b2c06a7 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,12 +1205,14 @@ 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]); Tcl_DStringInit(&buffer); - if (name[0]!=':' || name[1]!=':') { + if (name[0] == '\0') { + name = NULL; + } else if (name[0]!=':' || name[1]!=':') { Interp *iPtr = (Interp *) interp; if (iPtr->varFramePtr != NULL) { @@ -1220,7 +1223,26 @@ 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 (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; + } + } + + o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, namespaceName); Tcl_DStringFree(&buffer); } |