summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/ledit.n2
-rwxr-xr-xgeneric/tclArithSeries.c8
-rw-r--r--generic/tclCmdIL.c1
-rw-r--r--generic/tclEvent.c8
-rw-r--r--generic/tclExecute.c7
-rw-r--r--generic/tclListObj.c10
-rw-r--r--generic/tclParse.c30
-rw-r--r--generic/tclParse.h2
-rw-r--r--tests/lseq.test17
-rw-r--r--tests/parse.test6
-rw-r--r--tests/parseExpr.test4
11 files changed, 67 insertions, 28 deletions
diff --git a/doc/ledit.n b/doc/ledit.n
index 48e6da5..70e0bf3 100644
--- a/doc/ledit.n
+++ b/doc/ledit.n
@@ -18,7 +18,7 @@ ledit \- Replace elements of a list stored in variable
The command fetches the list value in variable \fIlistVar\fR and replaces the
elements in the range given by indices \fIfirst\fR to \fIlast\fR (inclusive)
with the \fIvalue\fR arguments. The resulting list is then stored back in
-\fIlistVar\fR and returned as the result of the command.
+\fIlistVar\fR and returned as the result of the command.
.PP
Arguments \fIfirst\fR and \fIlast\fR are index values specifying the first and
last elements of the range to replace. They are interpreted
diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c
index 1302780..d88c8ed 100755
--- a/generic/tclArithSeries.c
+++ b/generic/tclArithSeries.c
@@ -307,12 +307,9 @@ TclNewArithSeriesObj(
assignNumber(useDoubles, &end, &dend, endObj);
}
if (lenObj) {
- int tcl_number_type;
- Tcl_WideInt *valuePtr;
- if (TclGetNumberFromObj(interp, lenObj, (ClientData*)&valuePtr, &tcl_number_type) != TCL_OK) {
+ if (TCL_OK != Tcl_GetWideIntFromObj(interp, lenObj, &len)) {
return TCL_ERROR;
}
- len = *valuePtr;
}
if (startObj && endObj) {
@@ -920,8 +917,11 @@ TclArithSeriesObjReverse(
len = arithSeriesRepPtr->len;
TclArithSeriesObjIndex(arithSeriesPtr, (len-1), &startObj);
+ Tcl_IncrRefCount(startObj);
TclArithSeriesObjIndex(arithSeriesPtr, 0, &endObj);
+ Tcl_IncrRefCount(endObj);
TclArithSeriesObjStep(arithSeriesPtr, &stepObj);
+ Tcl_IncrRefCount(stepObj);
if (isDouble) {
Tcl_GetDoubleFromObj(NULL, startObj, &dstart);
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index fa9d138..150978a 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2270,7 +2270,6 @@ Tcl_JoinObjCmd(
return TCL_ERROR;
}
Tcl_AppendObjToObj(resObjPtr, valueObj);
- Tcl_DecrRefCount(valueObj);
}
} else {
for (i = 0; i < listLen; i++) {
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 6d7d968..4a61d60 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1501,12 +1501,12 @@ Tcl_VwaitObjCmd(
Tcl_Channel chan;
Tcl_WideInt diff = -1;
VwaitItem localItems[32], *vwaitItems = localItems;
- static const char *const options[] = {
+ static const char *const vWaitOptionStrings[] = {
"-all", "-extended", "-nofileevents", "-noidleevents",
"-notimerevents", "-nowindowevents", "-readable",
"-timeout", "-variable", "-writable", "--", NULL
};
- enum options {
+ enum vWaitOptions {
OPT_ALL, OPT_EXTD, OPT_NO_FEVTS, OPT_NO_IEVTS,
OPT_NO_TEVTS, OPT_NO_WEVTS, OPT_READABLE,
OPT_TIMEOUT, OPT_VARIABLE, OPT_WRITABLE, OPT_LAST
@@ -1531,7 +1531,7 @@ Tcl_VwaitObjCmd(
if (name[0] != '-') {
break;
}
- if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
+ if (Tcl_GetIndexFromObj(interp, objv[i], vWaitOptionStrings, "option", 0,
&index) != TCL_OK) {
result = TCL_ERROR;
goto done;
@@ -1560,7 +1560,7 @@ Tcl_VwaitObjCmd(
needArg:
Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "argument required for \"%s\"", options[index]));
+ "argument required for \"%s\"", vWaitOptionStrings[index]));
Tcl_SetErrorCode(interp, "TCL", "EVENT", "ARGUMENT", NULL);
result = TCL_ERROR;
goto done;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 2590b37..fae2aa6 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4673,6 +4673,7 @@ TEBCresume(
TRACE_ERROR(interp);
goto gotError;
}
+ Tcl_IncrRefCount(objResultPtr); // reference held here
goto lindexDone;
}
@@ -4977,7 +4978,11 @@ TEBCresume(
*/
do {
- Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
+ if (isArithSeries) {
+ TclArithSeriesObjIndex(value2Ptr, i, &o);
+ } else {
+ Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
+ }
if (o != NULL) {
s2 = Tcl_GetStringFromObj(o, &s2len);
} else {
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 4156aed..2ce2897 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -1366,6 +1366,9 @@ TclListObjCopy(
Tcl_Obj *copyObj;
if (!TclHasInternalRep(listObj, &tclListType)) {
+ if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
+ return TclArithSeriesObjCopy(interp, listObj);
+ }
if (SetListFromAny(interp, listObj) != TCL_OK) {
return NULL;
}
@@ -1938,10 +1941,6 @@ Tcl_ListObjIndex(
Tcl_Obj **elemObjs;
ListSizeT numElems;
- if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
- return TclArithSeriesObjIndex(listObj, index, objPtrPtr);
- }
-
/*
* TODO
* Unlike the original list code, this does not optimize for lindex'ing
@@ -2636,8 +2635,8 @@ TclLindexFlat(
}
if (i==0) {
TclArithSeriesObjIndex(listObj, index, &elemObj);
- Tcl_IncrRefCount(elemObj);
} else if (index > 0) {
+ /* ArithSeries cannot be a list of lists */
Tcl_DecrRefCount(elemObj);
TclNewObj(elemObj);
Tcl_IncrRefCount(elemObj);
@@ -3299,7 +3298,6 @@ SetListFromAny(
if (TclArithSeriesObjIndex(objPtr, j, &elemPtrs[j]) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_IncrRefCount(elemPtrs[j]);/* Since list now holds ref to it. */
}
} else {
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 3eeea9b..95458ea 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -33,6 +33,7 @@
* meaning in ParseTokens: backslash, dollar sign, or
* open bracket.
* TYPE_QUOTE - Character is a double quote.
+ * TYPE_OPEN_PAREN - Character is a left parenthesis.
* TYPE_CLOSE_PAREN - Character is a right parenthesis.
* TYPE_CLOSE_BRACK - Character is a right square bracket.
* TYPE_BRACE - Character is a curly brace (either left or right).
@@ -54,7 +55,7 @@ const char tclCharTypeTable[] = {
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
TYPE_SPACE, TYPE_NORMAL, TYPE_QUOTE, TYPE_NORMAL,
TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_CLOSE_PAREN, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_OPEN_PAREN, TYPE_CLOSE_PAREN, TYPE_NORMAL, TYPE_NORMAL,
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
@@ -1398,15 +1399,28 @@ Tcl_ParseVarName(
*/
if (*src == '{') {
+ char ch; int braceCount = 0;
src++;
numBytes--;
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->start = src;
tokenPtr->numComponents = 0;
- while (numBytes && (*src != '}')) {
+ ch = *src;
+ while (numBytes && (braceCount>0 || ch != '}')) {
+ switch (ch) {
+ case '{': braceCount++; break;
+ case '}': braceCount--; break;
+ case '\\':
+ /* if 2 or more left, consume 2, else consume
+ just the \ and let it run into the end */
+ if (numBytes > 1) {
+ src++; numBytes--;
+ }
+ }
numBytes--;
src++;
+ ch= *src;
}
if (numBytes == 0) {
if (parsePtr->interp != NULL) {
@@ -1462,11 +1476,11 @@ Tcl_ParseVarName(
* any number of substitutions.
*/
- if (TCL_OK != ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN,
+ if (TCL_OK != ParseTokens(src+1, numBytes-1, TYPE_BAD_ARRAY_INDEX,
TCL_SUBST_ALL, parsePtr)) {
goto error;
}
- if ((parsePtr->term == src+numBytes) || (*parsePtr->term != ')')){
+ if ((parsePtr->term == src+numBytes)){
if (parsePtr->interp != NULL) {
Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
"missing )", -1));
@@ -1475,6 +1489,14 @@ Tcl_ParseVarName(
parsePtr->term = src;
parsePtr->incomplete = 1;
goto error;
+ } else if ((*parsePtr->term != ')')){
+ if (parsePtr->interp != NULL) {
+ Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
+ "invalid character in array index", -1));
+ }
+ parsePtr->errorType = TCL_PARSE_SYNTAX;
+ parsePtr->term = src;
+ goto error;
}
src = parsePtr->term + 1;
}
diff --git a/generic/tclParse.h b/generic/tclParse.h
index 5f75c9a..a9efd74 100644
--- a/generic/tclParse.h
+++ b/generic/tclParse.h
@@ -11,6 +11,8 @@
#define TYPE_CLOSE_PAREN 0x10
#define TYPE_CLOSE_BRACK 0x20
#define TYPE_BRACE 0x40
+#define TYPE_OPEN_PAREN 0x80
+#define TYPE_BAD_ARRAY_INDEX (TYPE_OPEN_PAREN|TYPE_CLOSE_PAREN|TYPE_QUOTE|TYPE_BRACE)
#define CHAR_TYPE(c) tclCharTypeTable[(unsigned char)(c)]
diff --git a/tests/lseq.test b/tests/lseq.test
index 3d9988e..8bd8114 100644
--- a/tests/lseq.test
+++ b/tests/lseq.test
@@ -223,6 +223,8 @@ test lseq-3.1 {experiement} {
if {$ans eq {}} {
set ans OK
}
+ unset factor
+ unset l
set ans
} {OK}
@@ -376,13 +378,18 @@ test lseq-3.26 {lsort shimmer} arithSeriesShimmer {
list ${rep-before} $lexical_sort ${rep-after}
} {arithseries {0 1 10 11 12 13 14 15 2 3 4 5 6 7 8 9} arithseries}
-test lseq-3.27 {lreplace shimmer} arithSeriesShimmer {
+test lseq-3.27 {lreplace shimmer} -constraints arithSeriesShimmer -body {
set r [lseq 15 0]
set rep-before [lindex [tcl::unsupported::representation $r] 3]
set lexical_sort [lreplace $r 3 5 A B C]
set rep-after [lindex [tcl::unsupported::representation $r] 3]
list ${rep-before} $lexical_sort ${rep-after}
-} {arithseries {15 14 13 A B C 9 8 7 6 5 4 3 2 1 0} arithseries}
+} -cleanup {
+ unset r
+ unset rep-before
+ unset lexical_sort
+ unset rep-after
+} -result {arithseries {15 14 13 A B C 9 8 7 6 5 4 3 2 1 0} arithseries}
test lseq-3.28 {lreverse bug in ArithSeries} {} {
set r [lseq -5 17 3]
@@ -502,9 +509,15 @@ test lseq-4.5 {lindex off by one} -body {
unset res
} -result {4 3}
+# Panic when using variable value?
+test lseq-4.6 {panic using variable index} {
+ set i 0
+ lindex [lseq 10] $i
+} {0}
# cleanup
::tcltest::cleanupTests
+
return
# Local Variables:
diff --git a/tests/parse.test b/tests/parse.test
index 5b38318..517d577 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -601,8 +601,8 @@ test parse-12.6 {Tcl_ParseVarName procedure, braced variable name} testparser {
testparser {${..[]b}cd} 0
} {- {${..[]b}cd} 1 word {${..[]b}cd} 3 variable {${..[]b}} 1 text {..[]b} 0 text cd 0 {}}
test parse-12.7 {Tcl_ParseVarName procedure, braced variable name} testparser {
- testparser "\$\{\{\} " 0
-} {- \$\{\{\}\ 1 word \$\{\{\} 2 variable \$\{\{\} 1 text \{ 0 {}}
+ testparser "\$\{\{\\\\\}\} " 0
+} {- {${{\\}} } 1 word {${{\\}}} 2 variable {${{\\}}} 1 text {{\\}} 0 {}}
test parse-12.8 {Tcl_ParseVarName procedure, missing close brace} testparser {
list [catch {testparser "$\{abc" 0} msg] $msg $::errorInfo
} {1 {missing close-brace for variable name} missing\ close-brace\ for\ variable\ name\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\$\\\{abc\"\ 0\"}
@@ -797,7 +797,7 @@ test parse-15.16 {CommandComplete procedure} {
} 1
test parse-15.17 {CommandComplete procedure} {
info complete {a b "c $dd("}
-} 0
+} 1
test parse-15.18 {CommandComplete procedure} {
info complete {a b "c \"}
} 0
diff --git a/tests/parseExpr.test b/tests/parseExpr.test
index c70c5e3..b9245ce 100644
--- a/tests/parseExpr.test
+++ b/tests/parseExpr.test
@@ -919,8 +919,8 @@ test parseExpr-21.43 {error message} -body {
in expression \"...8901234567890*\"foobar\$\{abcdefghijklmnopqrstuv...\""
test parseExpr-21.44 {error message} -body {
expr {123456789012345678901234567890*"foo$bar(abcdefghijklmnopqrstuvwxyz"}
-} -returnCodes error -result {missing )
-in expression "...8901234567890*"foo$bar(abcdefghijklmnopqrstuv..."}
+} -returnCodes error -result {invalid character in array index
+in expression "...8901234567890*"foo$bar(abcdefghijklmnopqrstu..."}
test parseExpr-21.45 {error message} -body {
expr {123456789012345678901234567890*"foo$bar([{}abcdefghijklmnopqrstuvwxyz])"}
} -returnCodes error -result {extra characters after close-brace
generated by cgit v0.12 at 2024-11-16 09:21:33 (GMT)