diff options
| -rw-r--r-- | ChangeLog | 2 | ||||
| -rw-r--r-- | generic/tclVar.c | 8 | ||||
| -rw-r--r-- | tests/set-old.test | 11 |
3 files changed, 14 insertions, 7 deletions
@@ -2,6 +2,8 @@ * generic/tclVar.c: Added more use of error-codes and reduced the stack overhead of older interfaces. + (ArrayGetCmd): Stop silly crash when using a trivial pattern due to + error in conversion to ensemble. 2010-02-03 Donal K. Fellows <dkf@users.sf.net> diff --git a/generic/tclVar.c b/generic/tclVar.c index f39383d..63aebca 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.191 2010/02/04 10:53:34 dkf Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.192 2010/02/04 13:46:32 dkf Exp $ */ #include "tclInt.h" @@ -3558,7 +3558,7 @@ ArrayGetCmd( TclNewObj(nameLstPtr); Tcl_IncrRefCount(nameLstPtr); if ((pattern != NULL) && TclMatchIsTrivial(pattern)) { - varPtr2 = VarHashFindVar(varPtr->value.tablePtr, objv[3]); + varPtr2 = VarHashFindVar(varPtr->value.tablePtr, objv[2]); if (varPtr2 == NULL) { goto searchDone; } @@ -3736,12 +3736,12 @@ ArrayNamesCmd( patternPtr = objv[2]; pattern = TclGetString(patternPtr); } else if (objc == 4) { - patternPtr = objv[3]; - pattern = TclGetString(patternPtr); if (Tcl_GetIndexFromObj(interp, objv[2], options, "option", 0, &mode) != TCL_OK) { return TCL_ERROR; } + patternPtr = objv[3]; + pattern = TclGetString(patternPtr); } else { patternPtr = NULL; pattern = NULL; diff --git a/tests/set-old.test b/tests/set-old.test index 54befbd..a519a44 100644 --- a/tests/set-old.test +++ b/tests/set-old.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: set-old.test,v 1.22 2010/02/02 16:12:01 dkf Exp $ +# RCS: @(#) $Id: set-old.test,v 1.23 2010/02/04 13:46:33 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -671,9 +671,14 @@ test set-old-8.55 {array command, array names -glob} { list [catch {array names a -glob} msg] $msg } {0 -glob} test set-old-8.56 {array command, array statistics on a non-array} { - catch {unset a} - list [catch {array statistics a} msg] $msg + catch {unset a} + list [catch {array statistics a} msg] $msg } [list 1 "\"a\" isn't an array"] +test set-old-8.57 {array command, array get with trivial pattern} { + catch {unset a} + set a(x) 1 + array get a x +} {x 1} test set-old-9.1 {ids for array enumeration} { catch {unset a} |