* tests/listbox.test:

	* generic/tkListbox.c: corrected error handling when setting to an
	invalid listvar value. [Bug #503613]

2 files changed, 114 insertions, 88 deletions

diff --git a/generic/tkListbox.c b/generic/tkListbox.c
index 7bf5e0b..3eaa135 100644
--- a/generic/tkListbox.c
+++ b/generic/tkListbox.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkListbox.c,v 1.24 2002/01/18 02:55:06 hobbs Exp $
+ * RCS: @(#) $Id: tkListbox.c,v 1.25 2002/02/26 01:07:29 hobbs Exp $
  */
 
 #include "tkPort.h"
@@ -1529,7 +1529,8 @@ ConfigureListbox(interp, listPtr, objc, objv, flags)
 {
     Tk_SavedOptions savedOptions;
     Tcl_Obj *oldListObj = NULL;
-    int oldExport;
+    Tcl_Obj *errorResult = NULL;
+    int oldExport, error;
 
     oldExport = listPtr->exportSelection;
     if (listPtr->listVarName != NULL) {
@@ -1537,99 +1538,118 @@ ConfigureListbox(interp, listPtr, objc, objv, flags)
 		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
 		ListboxListVarProc, (ClientData) listPtr);
     }
-    
-    if (Tk_SetOptions(interp, (char *)listPtr,
-	    listPtr->optionTable, objc, objv, listPtr->tkwin,
-	    &savedOptions, (int *)NULL) != TCL_OK) {
-	Tk_RestoreSavedOptions(&savedOptions);
-	return TCL_ERROR;
-    }
-    
-    /*
-     * A few options need special processing, such as setting the
-     * background from a 3-D border.
-     */
 
-    Tk_SetBackgroundFromBorder(listPtr->tkwin, listPtr->normalBorder);
+    for (error = 0; error <= 1; error++) {
+	if (!error) {
+	    /*
+	     * First pass: set options to new values.
+	     */
 
-    if (listPtr->highlightWidth < 0) {
-	listPtr->highlightWidth = 0;
-    }
-    listPtr->inset = listPtr->highlightWidth + listPtr->borderWidth;
+	    if (Tk_SetOptions(interp, (char *) listPtr,
+		    listPtr->optionTable, objc, objv,
+		    listPtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) {
+		continue;
+	    }
+	} else {
+	    /*
+	     * Second pass: restore options to old values.
+	     */
 
-    /*
-     * Claim the selection if we've suddenly started exporting it and
-     * there is a selection to export.
-     */
+	    errorResult = Tcl_GetObjResult(interp);
+	    Tcl_IncrRefCount(errorResult);
+	    Tk_RestoreSavedOptions(&savedOptions);
+	}
 
-    if (listPtr->exportSelection && !oldExport
-	    && (listPtr->numSelected != 0)) {
-	Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection,
-		(ClientData) listPtr);
-    }
+	/*
+	 * A few options need special processing, such as setting the
+	 * background from a 3-D border.
+	 */
 
-    
-    /* Verify the current status of the list var.
-     * PREVIOUS STATE    | NEW STATE     | ACTION
-     * ------------------+---------------+----------------------------------
-     * no listvar        | listvar       | If listvar does not exist, create
-     *                                     it and copy the internal list obj's
-     *                                     content to the new var.  If it does
-     *                                     exist, toss the internal list obj.
-     *
-     * listvar           | no listvar    | Copy old listvar content to the
-     *                                     internal list obj
-     *
-     * listvar           | listvar       | no special action
-     *
-     * no listvar        | no listvar    | no special action
-     */
-    oldListObj = listPtr->listObj;
-    if (listPtr->listVarName != NULL) {
-	Tcl_Obj *listVarObj = Tcl_GetVar2Ex(interp, listPtr->listVarName,
-		(char *)NULL, TCL_GLOBAL_ONLY);
-	int dummy;
-	if (listVarObj == NULL) {
-	    if (listPtr->listObj != NULL) {
-		listVarObj = listPtr->listObj;
-	    } else {
-		listVarObj = Tcl_NewObj();
+	Tk_SetBackgroundFromBorder(listPtr->tkwin, listPtr->normalBorder);
+
+	if (listPtr->highlightWidth < 0) {
+	    listPtr->highlightWidth = 0;
+	}
+	listPtr->inset = listPtr->highlightWidth + listPtr->borderWidth;
+
+	/*
+	 * Claim the selection if we've suddenly started exporting it and
+	 * there is a selection to export.
+	 */
+
+	if (listPtr->exportSelection && !oldExport
+		&& (listPtr->numSelected != 0)) {
+	    Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection,
+		    (ClientData) listPtr);
+	}
+
+	/* Verify the current status of the list var.
+	 * PREVIOUS STATE | NEW STATE  | ACTION
+	 * ---------------+------------+----------------------------------
+	 * no listvar     | listvar    | If listvar does not exist, create
+	 *                               it and copy the internal list obj's
+	 *                               content to the new var.  If it does
+	 *                               exist, toss the internal list obj.
+	 *
+	 * listvar        | no listvar | Copy old listvar content to the
+	 *                               internal list obj
+	 *
+	 * listvar        | listvar    | no special action
+	 *
+	 * no listvar     | no listvar | no special action
+	 */
+	oldListObj = listPtr->listObj;
+	if (listPtr->listVarName != NULL) {
+	    Tcl_Obj *listVarObj = Tcl_GetVar2Ex(interp, listPtr->listVarName,
+		    (char *) NULL, TCL_GLOBAL_ONLY);
+	    int dummy;
+	    if (listVarObj == NULL) {
+		listVarObj = (oldListObj ? oldListObj : Tcl_NewObj());
+		if (Tcl_SetVar2Ex(interp, listPtr->listVarName, (char *) NULL,
+			listVarObj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+			== NULL) {
+		    if (oldListObj == NULL) {
+			Tcl_DecrRefCount(listVarObj);
+		    }
+		    continue;
+		}
 	    }
-	    if (Tcl_SetVar2Ex(interp, listPtr->listVarName, (char *)NULL,
-		    listVarObj, TCL_GLOBAL_ONLY) == NULL) {
-		Tcl_DecrRefCount(listVarObj);
-		Tk_RestoreSavedOptions(&savedOptions);
-		return TCL_ERROR;
+	    /* Make sure the object is a good list object */
+	    if (Tcl_ListObjLength(listPtr->interp, listVarObj, &dummy)
+		    != TCL_OK) {
+		Tcl_AppendResult(listPtr->interp,
+			": invalid -listvariable value", (char *) NULL);
+		continue;
 	    }
-	}
-	/* Make sure the object is a good list object */
-	if (Tcl_ListObjLength(listPtr->interp, listVarObj, &dummy) != TCL_OK) {
-	    Tk_RestoreSavedOptions(&savedOptions);
-	    Tcl_AppendResult(listPtr->interp, ": invalid listvar value",
-		    (char *)NULL);
-	    return TCL_ERROR;
-	}
-    
-	listPtr->listObj = listVarObj;
-	Tcl_TraceVar(listPtr->interp, listPtr->listVarName,
-                TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
-                ListboxListVarProc, (ClientData) listPtr);
-    } else {
-	if (listPtr->listObj == NULL) {
+
+	    listPtr->listObj = listVarObj;
+	    Tcl_TraceVar(listPtr->interp, listPtr->listVarName,
+		    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+		    ListboxListVarProc, (ClientData) listPtr);
+	} else if (listPtr->listObj == NULL) {
 	    listPtr->listObj = Tcl_NewObj();
 	}
+	Tcl_IncrRefCount(listPtr->listObj);
+	if (oldListObj != NULL) {
+	    Tcl_DecrRefCount(oldListObj);
+	}
+	break;
     }
-    Tcl_IncrRefCount(listPtr->listObj);
-    if (oldListObj != NULL) {
-	Tcl_DecrRefCount(oldListObj);
+    if (!error) {
+	Tk_FreeSavedOptions(&savedOptions);
     }
 
     /* Make sure that the list length is correct */
     Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
     
-    Tk_FreeSavedOptions(&savedOptions);
-    ListboxWorldChanged((ClientData) listPtr);
-    return TCL_OK;
+    if (error) {
+        Tcl_SetObjResult(interp, errorResult);
+	Tcl_DecrRefCount(errorResult);
+	return TCL_ERROR;
+    } else {
+	ListboxWorldChanged((ClientData) listPtr);
+	return TCL_OK;
+    }
 }
 
 /*
diff --git a/tests/listbox.test b/tests/listbox.test
index acd4da3..0033ee4 100644
--- a/tests/listbox.test
+++ b/tests/listbox.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: listbox.test,v 1.16 2001/09/01 00:51:11 hobbs Exp $
+# RCS: @(#) $Id: listbox.test,v 1.17 2002/02/26 01:07:29 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -940,11 +940,19 @@ test listbox-4.18 {ConfigureListbox, no listvar -> bad listvar} {
     catch {destroy .l}
     listbox .l
     .l insert end a b c d
-    set x {this is a " bad list}
+    set x "this is a \" bad list"
     catch {.l configure -listvar x} result
     list [.l get 0 end] [.l cget -listvar] $result
 } [list [list a b c d] {} \
-	"unmatched open quote in list: invalid listvar value"]
+	"unmatched open quote in list: invalid -listvariable value"]
+test listbox-4.19 {ConfigureListbox, no listvar -> bad non-existent listvar} {
+    catch {destroy .l}
+    listbox .l -listvar foo
+    .l insert end a b c d
+    catch {.l configure -listvar ::zoo::bar::foo} result
+    list [.l get 0 end] [.l cget -listvar] $foo $result
+} [list [list a b c d] foo [list a b c d] \
+	{can't set "::zoo::bar::foo": parent namespace doesn't exist}]
 
 # No tests for DisplayListbox:  I don't know how to test this procedure.
 
@@ -1848,7 +1856,7 @@ test listbox-21.11 {ListboxListVarProc, bad list} {
     catch {unset x}
     listbox .l -listvar x
     set x [list a b c d]
-    catch {set x {this is a " bad list}} result
+    catch {set x "this is a \" bad list"} result
     set result
 } {can't set "x": invalid listvar value}
 test listbox-21.12 {ListboxListVarProc, cleanup item attributes} {
@@ -2100,10 +2108,6 @@ test listbox-26.5 {listbox disabled state disallows active modification} {
     .l index active
 } 0
 
-resetGridInfo
-eval destroy [winfo children .]
-option clear
-
 test listbox-27.1 {widget deletion while active} {
     destroy .l
     pack [listbox .l]
@@ -2113,7 +2117,9 @@ test listbox-27.1 {widget deletion while active} {
     winfo exists .l
 } 0
 
+resetGridInfo
 eval destroy [winfo children .]
+option clear
 
 # cleanup
 ::tcltest::cleanupTests