* tests/listbox.test: Added tests for bad -listvar's.

* generic/tkListbox.c: Added handlers for bad -listvar's (ie, bad
lists)


FossilOrigin-Name: a8241d6f0daec92b0050bf0d6f8aa538d7b41265

3 files changed, 60 insertions, 16 deletions

diff --git a/ChangeLog b/ChangeLog
index 36f29f1..508ffdf 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,15 @@
 1999-11-17  Eric Melski  <ericm@scriptics.com>
 
+	* tests/listbox.test: Added tests for bad -listvar's.
+
+	* generic/tkListbox.c: Added handlers for bad -listvar's (ie, bad
+	lists)
+
+	* tests/listbox.test: Added tests for ListboxUpdateHScrollbar.
+
+	* generic/tkListbox.c: Changed some old static buffers to base
+	size on TCL_DOUBLLE_SPACE instead of (completely) hardcoding the size.
+
 	* tests/listbox.test: New tests for -listvar functionality, and an
 	odd extra case that wasn't covered before.
 
diff --git a/generic/tkListbox.c b/generic/tkListbox.c
index 9d75cd7..36dbf76 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.7 1999/11/17 22:13:02 ericm Exp $
+ * RCS: @(#) $Id: tkListbox.c,v 1.8 1999/11/18 01:47:07 ericm Exp $
  */
 
 #include "tkPort.h"
@@ -1276,8 +1276,6 @@ ConfigureListbox(interp, listPtr, objc, objv, flags)
 	return TCL_ERROR;
     }
     
-    Tk_FreeSavedOptions(&savedOptions);
-
     /*
      * A few options need special processing, such as setting the
      * background from a 3-D border.
@@ -1319,9 +1317,10 @@ ConfigureListbox(interp, listPtr, objc, objv, flags)
      */
     oldListObj = listPtr->listObj;
     if (listPtr->listVarName != NULL) {
-	if (Tcl_GetVar2(interp, listPtr->listVarName, (char *)NULL,
-		TCL_GLOBAL_ONLY) == NULL) {
-	    Tcl_Obj *listVarObj;
+	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 {
@@ -1330,11 +1329,17 @@ ConfigureListbox(interp, listPtr, objc, objv, flags)
 	    if (Tcl_SetVar2Ex(interp, listPtr->listVarName, (char *)NULL,
 		    listVarObj, TCL_GLOBAL_ONLY) == NULL) {
 		Tcl_DecrRefCount(listVarObj);
+		Tk_RestoreSavedOptions(&savedOptions);
 		return TCL_ERROR;
 	    }
 	}
-	listPtr->listObj = Tcl_GetVar2Ex(interp, listPtr->listVarName,
-		(char *)NULL, TCL_GLOBAL_ONLY);
+	/* Make sure the object is a good list object */
+	if (Tcl_ListObjLength(listPtr->interp, listVarObj, &dummy) != TCL_OK) {
+	    Tk_RestoreSavedOptions(&savedOptions);
+	    return TCL_ERROR;
+	}
+    
+	listPtr->listObj = listVarObj;
 	Tcl_TraceVar(listPtr->interp, listPtr->listVarName,
                 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
                 ListboxListVarProc, (ClientData) listPtr);
@@ -1351,6 +1356,7 @@ ConfigureListbox(interp, listPtr, objc, objv, flags)
     /* 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;
 }
@@ -2794,7 +2800,7 @@ ListboxListVarProc(clientData, interp, name1, name2, flags)
     int flags;                  /* Information about what happened. */
 {
     Listbox *listPtr = (Listbox *)clientData;
-    Tcl_Obj *oldListObj;
+    Tcl_Obj *oldListObj, *varListObj;
     int oldLength;
     int i;
     Tcl_HashEntry *entry;
@@ -2811,16 +2817,28 @@ ListboxListVarProc(clientData, interp, name1, name2, flags)
 	}
     } else {
 	oldListObj = listPtr->listObj;
-	/* Make sure the internal pointer points to the correct object */
-	listPtr->listObj = Tcl_GetVar2Ex(listPtr->interp, listPtr->listVarName,
+	varListObj = Tcl_GetVar2Ex(listPtr->interp, listPtr->listVarName,
 		(char *)NULL, TCL_GLOBAL_ONLY);
+	/*
+	 * Make sure the new value is a good list; if it's not, disallow
+	 * the change -- the fact that it is a listvar means that it must
+	 * always be a valid list
+	 */
+	if (Tcl_ListObjLength(listPtr->interp, varListObj, &i) != TCL_OK) {
+	    Tcl_SetVar2Ex(interp, listPtr->listVarName, (char *)NULL,
+		    oldListObj, TCL_GLOBAL_ONLY);
+	    varListObj = oldListObj;
+	}
+	
+	listPtr->listObj = varListObj;
 	/* Incr the obj ref count so it doesn't vanish if the var is unset */
 	Tcl_IncrRefCount(listPtr->listObj);
 	/* Clean up the ref to our old list obj */
 	Tcl_DecrRefCount(oldListObj);
     }
 
-    /* If the list length has decreased, then we should clean up the selection
+    /*
+     * If the list length has decreased, then we should clean up the selection
      * from elements past the end of the new list
      */
     oldLength = listPtr->nElements;
@@ -2834,7 +2852,6 @@ ListboxListVarProc(clientData, interp, name1, name2, flags)
 	}
     }
 
-    
     /*
      * The computed maxWidth may have changed as a result of this operation.
      * However, we don't want to recompute it every time this trace fires
@@ -2844,7 +2861,7 @@ ListboxListVarProc(clientData, interp, name1, name2, flags)
      */
     listPtr->flags |= MAXWIDTH_IS_STALE;
     
-    EventuallyRedrawRange(clientData, 0, listPtr->nElements-1);
+    EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
     return (char*)NULL;
 }
 
diff --git a/tests/listbox.test b/tests/listbox.test
index d753251..5f3a683 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.6 1999/11/17 22:13:03 ericm Exp $
+# RCS: @(#) $Id: listbox.test,v 1.7 1999/11/18 01:47:08 ericm Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -934,6 +934,15 @@ test listbox-4.17 {ConfigureListbox, no listvar -> no listvar} {
     .l configure -listvar {}
     .l get 0 end
 } [list a b c d]
+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}
+    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"]
+
 # No tests for DisplayListbox:  I don't know how to test this procedure.
 
 test listbox-5.1 {ListboxComputeGeometry procedure} {fonts} {
@@ -1831,7 +1840,15 @@ test listbox-21.10 {ListboxListVarProc, test hscrollbar after listvar mod} {
     update
     set log
 } [list {x 0 1} {x 0 1} {x 0 0.5} {x 0 1}]
-    
+test listbox-21.11 {ListboxListVarProc, bad list} {
+    catch {destroy .l}
+    catch {unset x}
+    listbox .l -listvar x
+    set x [list a b c d]
+    set x {this is a " bad list}
+    set x
+} [list a b c d]
+
 # UpdateHScrollbar
 test listbox-22.1 {UpdateHScrollbar} {
     catch {destroy .l}