summaryrefslogtreecommitdiffstats
path: root/generic/tclOOBasic.c
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2017-12-06 12:27:50 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2017-12-06 12:27:50 (GMT)
commitfe4ff7a3fb60d7dd8c75e1b33dae1fc70f15fdc0 (patch)
tree4425148c353ff24118c096bbba98806625bf463e /generic/tclOOBasic.c
parentd2ef001c4971191280470eca5f1cf9dc1e2d8070 (diff)
parent72f0f0b3468809e3a3a26e448b3bd3be8a8398a6 (diff)
downloadtcl-fe4ff7a3fb60d7dd8c75e1b33dae1fc70f15fdc0.zip
tcl-fe4ff7a3fb60d7dd8c75e1b33dae1fc70f15fdc0.tar.gz
tcl-fe4ff7a3fb60d7dd8c75e1b33dae1fc70f15fdc0.tar.bz2
merge core-8-branch
Diffstat (limited to 'generic/tclOOBasic.c')
-rw-r--r--generic/tclOOBasic.c32
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);
}