summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2013-02-20 19:18:42 (GMT)
committerdgp <dgp@users.sourceforge.net>2013-02-20 19:18:42 (GMT)
commit5dd2f03f50c212303b25308aaef88ccc7b87bd76 (patch)
tree6e99efa39811eae5edb616659be3d95f47c63d0c /generic
parentee8be54ede03c2d1f37f4639dcff5b9a94722992 (diff)
downloadtcl-5dd2f03f50c212303b25308aaef88ccc7b87bd76.zip
tcl-5dd2f03f50c212303b25308aaef88ccc7b87bd76.tar.gz
tcl-5dd2f03f50c212303b25308aaef88ccc7b87bd76.tar.bz2
36054447 Convert [namespace export -clear] interface to something less stupid.
Test suite does not demand the stupidity continue, thank goodness.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclNamesp.c50
1 files changed, 18 insertions, 32 deletions
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 77352a1..22743a5 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -1032,7 +1032,7 @@ Tcl_AppendExportList(interp, namespacePtr, objPtr)
*/
if (namespacePtr == NULL) {
- nsPtr = (Namespace *) (Namespace *) Tcl_GetCurrentNamespace(interp);
+ nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
} else {
nsPtr = (Namespace *) namespacePtr;
}
@@ -3131,10 +3131,7 @@ NamespaceExportCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Namespace *currNsPtr = (Namespace*) Tcl_GetCurrentNamespace(interp);
- char *pattern, *string;
- int resetListFirst = 0;
- int firstArg, patternCt, i, result;
+ int firstArg, i;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 2, objv,
@@ -3143,37 +3140,28 @@ NamespaceExportCmd(dummy, interp, objc, objv)
}
/*
- * Process the optional "-clear" argument.
+ * If no pattern arguments are given, and "-clear" isn't specified,
+ * return the namespace's current export pattern list.
*/
- firstArg = 2;
- if (firstArg < objc) {
- string = Tcl_GetString(objv[firstArg]);
- if (strcmp(string, "-clear") == 0) {
- resetListFirst = 1;
- firstArg++;
- }
+ if (objc == 2) {
+ Tcl_Obj *listPtr = Tcl_NewObj();
+
+ (void) Tcl_AppendExportList(interp, NULL, listPtr);
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
}
/*
- * If no pattern arguments are given, and "-clear" isn't specified,
- * return the namespace's current export pattern list.
+ * Process the optional "-clear" argument.
*/
- patternCt = (objc - firstArg);
- if (patternCt == 0) {
- if (firstArg > 2) {
- return TCL_OK;
- } else { /* create list with export patterns */
- Tcl_Obj *listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- result = Tcl_AppendExportList(interp,
- (Tcl_Namespace *) currNsPtr, listPtr);
- if (result != TCL_OK) {
- return result;
- }
- Tcl_SetObjResult(interp, listPtr);
- return TCL_OK;
- }
+ firstArg = 2;
+ if ((objc > firstArg)
+ && (strcmp("-clear", Tcl_GetString(objv[firstArg])) == 0)) {
+ Tcl_Export(interp, NULL, "::", 1);
+ Tcl_ResetResult(interp);
+ firstArg++;
}
/*
@@ -3181,9 +3169,7 @@ NamespaceExportCmd(dummy, interp, objc, objv)
*/
for (i = firstArg; i < objc; i++) {
- pattern = Tcl_GetString(objv[i]);
- result = Tcl_Export(interp, (Tcl_Namespace *) currNsPtr, pattern,
- ((i == firstArg)? resetListFirst : 0));
+ int result = Tcl_Export(interp, NULL, Tcl_GetString(objv[i]), 0);
if (result != TCL_OK) {
return result;
}