[ecf35c7120] Correct nested handling of return option -options

(backport from 9.0)

2 files changed, 63 insertions, 42 deletions

diff --git a/generic/tclResult.c b/generic/tclResult.c
index 8ec9184..1d9ac84 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -1362,6 +1362,9 @@ TclProcessReturn(
  *
  *	Parses, checks, and stores the options to the [return] command.
  *
+ *	The number of arguments (objc) must be even, with the corresponding
+ *	objv holding values to be processed as key value .... key value.
+ *
  * Results:
  *	Returns TCL_ERROR if any of the option values are invalid. Otherwise,
  *	returns TCL_OK, and writes the returnOpts, code, and level values to
@@ -1373,6 +1376,49 @@ TclProcessReturn(
  *----------------------------------------------------------------------
  */
 
+static int
+ExpandedOptions(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Obj **keys,		/* Built-in keys (per thread) */
+    Tcl_Obj *returnOpts,	/* Options dict we are building */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    for (;  objc > 1;  objv += 2, objc -= 2) {
+	const char *opt = TclGetString(objv[0]);
+	const char *compare = TclGetString(keys[KEY_OPTIONS]);
+
+	if ((objv[0]->length == keys[KEY_OPTIONS]->length)
+		&& (memcmp(opt, compare, objv[0]->length) == 0)) {
+	    /* Process the -options switch to emulate {*} expansion.
+	     *
+	     * Use lists so duplicate keys are not lost.
+	     */
+
+	    int nestc;
+	    Tcl_Obj **nestv;
+
+	    if (TCL_ERROR == TclListObjGetElements(interp, objv[1],
+		    &nestc, &nestv) || (nestc % 2)) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"bad -options value: expected dictionary but got"
+			" \"%s\"", TclGetString(objv[1])));
+		Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS",
+			(char *)NULL);
+		return TCL_ERROR;
+	    }
+
+	    if (TCL_ERROR ==
+		    ExpandedOptions(interp, keys, returnOpts, nestc, nestv)) {
+		return TCL_ERROR;
+	    }
+	} else {
+	    Tcl_DictObjPut(NULL, returnOpts, objv[0], objv[1]);
+	}
+    }
+    return TCL_OK;
+}
+
 int
 TclMergeReturnOptions(
     Tcl_Interp *interp,		/* Current interpreter. */
@@ -1392,49 +1438,11 @@ TclMergeReturnOptions(
     Tcl_Obj *returnOpts;
     Tcl_Obj **keys = GetKeys();
 
-    TclNewObj(returnOpts);
-    for (;  objc > 1;  objv += 2, objc -= 2) {
-	int optLen, compareLen;
-	const char *opt = TclGetStringFromObj(objv[0], &optLen);
-	const char *compare =
-		TclGetStringFromObj(keys[KEY_OPTIONS], &compareLen);
-
-	if ((optLen == compareLen) && (memcmp(opt, compare, optLen) == 0)) {
-	    Tcl_DictSearch search;
-	    int done = 0;
-	    Tcl_Obj *keyPtr;
-	    Tcl_Obj *dict = objv[1];
-
-	nestedOptions:
-	    if (TCL_ERROR == Tcl_DictObjFirst(NULL, dict, &search,
-		    &keyPtr, &valuePtr, &done)) {
-		/*
-		 * Value is not a legal dictionary.
-		 */
+    /* All callers are expected to pass an even value for objc. */
 
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"bad %s value: expected dictionary but got \"%s\"",
-			compare, TclGetString(objv[1])));
-		Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS",
-			(char *)NULL);
-		goto error;
-	    }
-
-	    while (!done) {
-		Tcl_DictObjPut(NULL, returnOpts, keyPtr, valuePtr);
-		Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
-	    }
-
-	    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_OPTIONS], &valuePtr);
-	    if (valuePtr != NULL) {
-		dict = valuePtr;
-		Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_OPTIONS]);
-		goto nestedOptions;
-	    }
-
-	} else {
-	    Tcl_DictObjPut(NULL, returnOpts, objv[0], objv[1]);
-	}
+    TclNewObj(returnOpts);
+    if (TCL_ERROR == ExpandedOptions(interp, keys, returnOpts, objc, objv)) {
+	goto error;
     }
 
     /*
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index 5ca1ed4..b8f572b 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -197,6 +197,19 @@ test cmdMZ-return-2.18 {return option handling} {
 	return -code error -errorstack [list CALL a CALL b] yo
     } -> foo] [dictSort $foo] [info errorstack]
 } {2 {-code 1 -errorcode NONE -errorstack {CALL a CALL b} -level 1} {CALL a CALL b}}
+test cmdMZ-return-2.19 {return option handling} -body {
+    return -level 0 -options {-options {-code break} -code continue}
+} -returnCodes continue -result {}
+test cmdMZ-return-2.20 {return option handling} {
+    list [catch {
+	return -level 0 -options {-foo 1} -options {-bar 2} 
+    } -> foo] $foo
+} {0 {-foo 1 -bar 2 -code 0 -level 0}}
+test cmdMZ-return-2.21 {return option handling} {
+    list [catch {
+	return -level 0 -options {-options {-foo 1} -options {-bar 2}}
+    } -> foo] $foo
+} {0 {-foo 1 -bar 2 -code 0 -level 0}}
 
 # Check that the result of a [return -options $opts $result] is
 # indistinguishable from that of the originally caught script, no matter what