summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog10
-rw-r--r--doc/incr.n10
-rw-r--r--generic/tclExecute.c4
-rw-r--r--generic/tclVar.c10
-rw-r--r--tests/compile.test10
-rw-r--r--tests/incr-old.test9
-rw-r--r--tests/incr.test28
-rw-r--r--tests/set.test4
8 files changed, 47 insertions, 38 deletions
diff --git a/ChangeLog b/ChangeLog
index 5527cbc..4201d49 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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].
diff --git a/doc/incr.n b/doc/incr.n
index 1af0e85..90fdb2e 100644
--- a/doc/incr.n
+++ b/doc/incr.n
@@ -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
generated by cgit v0.12 at 2024-07-05 10:56:02 (GMT)