summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorericm <ericm>1999-11-18 02:24:41 (GMT)
committerericm <ericm>1999-11-18 02:24:41 (GMT)
commita5402ae646644c2199d06862f3b0e70257c6fb3a (patch)
treeec2f0d56df29f9a5eb0db051a7ff1248a74528d3
parent5beebee053db6f96bc2d8a15a80ec73fc7aef8b5 (diff)
downloadtk-a5402ae646644c2199d06862f3b0e70257c6fb3a.zip
tk-a5402ae646644c2199d06862f3b0e70257c6fb3a.tar.gz
tk-a5402ae646644c2199d06862f3b0e70257c6fb3a.tar.bz2
* tests/listbox.test: Updated tests for new error messages.
* generic/tkListbox.c: Improved error messages for bad -listvar's.
-rw-r--r--generic/tkListbox.c8
-rw-r--r--tests/listbox.test11
2 files changed, 11 insertions, 8 deletions
diff --git a/generic/tkListbox.c b/generic/tkListbox.c
index 36dbf76..913757c 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.8 1999/11/18 01:47:07 ericm Exp $
+ * RCS: @(#) $Id: tkListbox.c,v 1.9 1999/11/18 02:24:41 ericm Exp $
*/
#include "tkPort.h"
@@ -1336,6 +1336,8 @@ ConfigureListbox(interp, listPtr, objc, objv, flags)
/* 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;
}
@@ -2822,12 +2824,12 @@ ListboxListVarProc(clientData, interp, name1, name2, flags)
/*
* 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
+ * always be a valid list -- and return an error message.
*/
if (Tcl_ListObjLength(listPtr->interp, varListObj, &i) != TCL_OK) {
Tcl_SetVar2Ex(interp, listPtr->listVarName, (char *)NULL,
oldListObj, TCL_GLOBAL_ONLY);
- varListObj = oldListObj;
+ return("invalid listvar value");
}
listPtr->listObj = varListObj;
diff --git a/tests/listbox.test b/tests/listbox.test
index 5f3a683..76df7ef 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.7 1999/11/18 01:47:08 ericm Exp $
+# RCS: @(#) $Id: listbox.test,v 1.8 1999/11/18 02:24:41 ericm Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -941,7 +941,8 @@ test listbox-4.18 {ConfigureListbox, no listvar -> bad listvar} {
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"]
+} [list [list a b c d] {} \
+ "unmatched open quote in list: invalid listvar value"]
# No tests for DisplayListbox: I don't know how to test this procedure.
@@ -1845,9 +1846,9 @@ test listbox-21.11 {ListboxListVarProc, bad list} {
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]
+ catch {set x {this is a " bad list}} result
+ set result
+} {can't set "x": invalid listvar value}
# UpdateHScrollbar
test listbox-22.1 {UpdateHScrollbar} {