diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | doc/incr.n | 10 | ||||
| -rw-r--r-- | generic/tclExecute.c | 4 | ||||
| -rw-r--r-- | generic/tclVar.c | 10 | ||||
| -rw-r--r-- | tests/compile.test | 10 | ||||
| -rw-r--r-- | tests/incr-old.test | 9 | ||||
| -rw-r--r-- | tests/incr.test | 28 | ||||
| -rw-r--r-- | tests/set.test | 4 |
8 files changed, 47 insertions, 38 deletions
@@ -1,5 +1,15 @@ 2006-02-09 Don Porter <dgp@users.sourceforge.net> + TIP#215 IMPLEMENTATION + + * doc/incr.n: Revised [incr] to auto-initialize when varName + * generic/tclExecute.c: argument is unset. [Patch 1413115]. + * generic/tclVar.c: + * tests/compile.test: + * tests/incr-old.test: + * tests/incr.test: + * tests/set.test: + * tests/main.test (Tcl_Main-6.7): Improved robustness of command auto-completion test. [Bug 1422736]. @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: incr.n,v 1.5 2004/10/27 12:53:22 dkf Exp $ +'\" RCS: @(#) $Id: incr.n,v 1.6 2006/02/09 17:34:41 dgp Exp $ '\" .so man.macros .TH incr n "" Tcl "Tcl Built-In Commands" @@ -26,6 +26,12 @@ integer) is added to the value of variable \fIvarName\fR; otherwise 1 is added to \fIvarName\fR. The new value is stored as a decimal string in variable \fIvarName\fR and also returned as result. +.PP +.VS 8.5 +Starting with the Tcl 8.5 release, the variable \fIvarName\fR passed +to \fBincr\fR may be unset, and in that case, it will be set to +the value \fIincrement\fR or to the default increment value of \fB1\fR. +.VE 8.5 .SH EXAMPLES Add one to the contents of the variable \fIx\fR: .CS @@ -44,7 +50,7 @@ variable \fIx\fR: .CE .PP Add nothing at all to the variable \fIx\fR (often useful for checking -whether an argument to a procedure is actually numeric and generating +whether an argument to a procedure is actually integral and generating an error if it is not): .CS \fBincr\fR x 0 diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 6fb49ec..6777cd2 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.225 2005/12/27 20:14:08 kennykb Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.226 2006/02/09 17:34:41 dgp Exp $ */ #include "tclInt.h" @@ -2403,7 +2403,7 @@ TclExecuteByteCode( part1 = TclGetString(objPtr); varPtr = TclObjLookupVar(interp, objPtr, part2, - TCL_LEAVE_ERR_MSG, "read", 0, 1, &arrayPtr); + TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr); if (varPtr == NULL) { Tcl_AddObjErrorInfo(interp, "\n (reading value of variable to increment)", -1); diff --git a/generic/tclVar.c b/generic/tclVar.c index 0977bfc..50b02b3 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -15,7 +15,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.119 2006/02/02 10:55:05 dkf Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.120 2006/02/09 17:34:42 dgp Exp $ */ #include "tclInt.h" @@ -1780,7 +1780,7 @@ TclIncrObjVar2( part2 = ((part2Ptr == NULL)? NULL : TclGetString(part2Ptr)); varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read", - 0, 1, &arrayPtr); + 1, 1, &arrayPtr); if (varPtr == NULL) { Tcl_AddObjErrorInfo(interp, "\n (reading value of variable to increment)", -1); @@ -1839,11 +1839,11 @@ TclPtrIncrObjVar( register Tcl_Obj *varValuePtr, *newValuePtr = NULL; int duplicated, code; + varPtr->refCount++; varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags); + varPtr->refCount--; if (varValuePtr == NULL) { - Tcl_AddObjErrorInfo(interp, - "\n (reading value of variable to increment)", -1); - return NULL; + varValuePtr = Tcl_NewIntObj(0); } if (Tcl_IsShared(varValuePtr)) { duplicated = 1; diff --git a/tests/compile.test b/tests/compile.test index b518c37..b7d4ffa 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -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: compile.test,v 1.40 2005/11/09 20:24:10 dgp Exp $ +# RCS: @(#) $Id: compile.test,v 1.41 2006/02/09 17:34:42 dgp Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -250,13 +250,13 @@ test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { list [catch {p} msg] $msg } {1 {list must have an even number of elements}} test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { - proc p {} { set r [list foobar] ; incr foo } + proc p {} { set r [list foobar] ; incr foo bar baz} list [catch {p} msg] $msg -} {1 {can't read "foo": no such variable}} +} {1 {wrong # args: should be "incr varName ?increment?"}} test compile-11.6 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { - proc p {} { set r [list foobar] ; incr foo bogus } + proc p {} { set r [list foobar] ; incr} list [catch {p} msg] $msg -} {1 {can't read "foo": no such variable}} +} {1 {wrong # args: should be "incr varName ?increment?"}} test compile-11.7 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { proc p {} { set r [list foobar] ; expr !a } list [catch {p} msg] $msg diff --git a/tests/incr-old.test b/tests/incr-old.test index 95250f8..5b93268 100644 --- a/tests/incr-old.test +++ b/tests/incr-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: incr-old.test,v 1.8 2004/11/03 17:16:05 dgp Exp $ +# RCS: @(#) $Id: incr-old.test,v 1.9 2006/02/09 17:34:42 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -47,11 +47,8 @@ test incr-old-2.2 {incr errors} { } {1 {wrong # args: should be "incr varName ?increment?"}} test incr-old-2.3 {incr errors} { catch {unset x} - list [catch {incr x} msg] $msg $errorInfo -} {1 {can't read "x": no such variable} {can't read "x": no such variable - (reading value of variable to increment) - invoked from within -"incr x"}} + incr x +} 1 test incr-old-2.4 {incr errors} { set x abc list [catch {incr x} msg] $msg $errorInfo diff --git a/tests/incr.test b/tests/incr.test index 07526c4..3bd1541 100644 --- a/tests/incr.test +++ b/tests/incr.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: incr.test,v 1.11 2004/11/03 17:16:05 dgp Exp $ +# RCS: @(#) $Id: incr.test,v 1.12 2006/02/09 17:34:42 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -87,9 +87,8 @@ test incr-1.13 {TclCompileIncrCmd: simple but new (unknown) local name} { proc p {} { incr bar } - catch {p} msg - set msg -} {can't read "bar": no such variable} + p +} 1 test incr-1.14 {TclCompileIncrCmd: simple local name, >255 locals} { proc 260locals {} { # create 260 locals @@ -211,11 +210,9 @@ test incr-1.25 {TclCompileIncrCmd: too many arguments} { test incr-1.26 {TclCompileIncrCmd: runtime error, bad variable name} { - list [catch {incr {"foo}} msg] $msg $errorInfo -} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable - (reading value of variable to increment) - invoked from within -"incr {"foo}"}} + unset -nocomplain {"foo} + incr {"foo} +} 1 test incr-1.27 {TclCompileIncrCmd: runtime error, bad variable name} -body { list [catch {incr [set]} msg] $msg $errorInfo } -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?" @@ -331,9 +328,8 @@ test incr-2.13 {incr command (not compiled): simple but new (unknown) local name set z incr $z bar } - catch {p} msg - set msg -} {can't read "bar": no such variable} + p +} 1 test incr-2.14 {incr command (not compiled): simple local name, >255 locals} { proc 260locals {} { set z incr @@ -467,12 +463,10 @@ test incr-2.25 {incr command (not compiled): too many arguments} { test incr-2.26 {incr command (not compiled): runtime error, bad variable name} { + unset -nocomplain {"foo} set z incr - list [catch {$z {"foo}} msg] $msg $errorInfo -} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable - (reading value of variable to increment) - invoked from within -"$z {"foo}"}} + $z {"foo} +} 1 test incr-2.27 {incr command (not compiled): runtime error, bad variable name} -body { set z incr list [catch {$z [set]} msg] $msg $errorInfo diff --git a/tests/set.test b/tests/set.test index ce1d31a..2a0dc61 100644 --- a/tests/set.test +++ b/tests/set.test @@ -10,7 +10,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.test,v 1.9 2004/11/03 17:16:05 dgp Exp $ +# RCS: @(#) $Id: set.test,v 1.10 2006/02/09 17:34:42 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -233,6 +233,7 @@ test set-1.26 {TclCompileSetCmd: various array constructs} { {b c} foo 51}]; # " just a matching end quote test set-2.1 {set command: runtime error, bad variable name} { + unset -nocomplain {"foo} list [catch {set {"foo}} msg] $msg $errorInfo } {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable while executing @@ -476,6 +477,7 @@ test set-3.24 {uncompiled set command: too many arguments} { } {wrong # args: should be "set varName ?newValue?"} test set-4.1 {uncompiled set command: runtime error, bad variable name} { + unset -nocomplain {"foo} set z set list [catch {$z {"foo}} msg] $msg $errorInfo } {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable |