220 lines
7.7 KiB
Diff
220 lines
7.7 KiB
Diff
Index: generic/tclExecute.c
|
||
==================================================================
|
||
--- generic/tclExecute.c
|
||
+++ generic/tclExecute.c
|
||
@@ -5235,12 +5235,16 @@
|
||
}
|
||
#endif
|
||
|
||
/* Every range of an empty list is an empty list */
|
||
if (objc == 0) {
|
||
- TRACE_APPEND(("\n"));
|
||
- NEXT_INST_F(9, 0, 0);
|
||
+ /* avoid return of not canonical list (e. g. spaces in string repr.) */
|
||
+ if (!valuePtr->bytes || !valuePtr->bytes[0]) {
|
||
+ TRACE_APPEND(("\n"));
|
||
+ NEXT_INST_F(9, 0, 0);
|
||
+ }
|
||
+ goto emptyList;
|
||
}
|
||
|
||
/* Decode index value operands. */
|
||
|
||
/*
|
||
|
||
Index: generic/tclTest.c
|
||
==================================================================
|
||
--- generic/tclTest.c
|
||
+++ generic/tclTest.c
|
||
@@ -218,10 +218,13 @@
|
||
static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr);
|
||
static void SpecialFree(char *blockPtr);
|
||
static int StaticInitProc(Tcl_Interp *interp);
|
||
static int TestasyncCmd(ClientData dummy,
|
||
Tcl_Interp *interp, int argc, const char **argv);
|
||
+static int TestpurebytesobjObjCmd(ClientData clientData,
|
||
+ Tcl_Interp *interp, int objc,
|
||
+ Tcl_Obj *const objv[]);
|
||
static int TestbytestringObjCmd(ClientData clientData,
|
||
Tcl_Interp *interp, int objc,
|
||
Tcl_Obj *const objv[]);
|
||
static int TestcmdinfoCmd(ClientData dummy,
|
||
Tcl_Interp *interp, int argc, const char **argv);
|
||
@@ -568,10 +571,11 @@
|
||
*/
|
||
|
||
Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL);
|
||
Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
|
||
Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL);
|
||
+ Tcl_CreateObjCommand(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL);
|
||
Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL);
|
||
Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
|
||
NULL, NULL);
|
||
Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd,
|
||
NULL, NULL);
|
||
@@ -2079,11 +2083,11 @@
|
||
int length, flags;
|
||
const char *script;
|
||
|
||
flags = 0;
|
||
if (objc == 3) {
|
||
- const char *global = Tcl_GetStringFromObj(objv[2], &length);
|
||
+ const char *global = Tcl_GetString(objv[2]);
|
||
if (strcmp(global, "global") != 0) {
|
||
Tcl_AppendResult(interp, "bad value \"", global,
|
||
"\": must be global", NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
@@ -4953,10 +4957,61 @@
|
||
int objc, /* Number of arguments. */
|
||
Tcl_Obj *const objv[]) /* The argument objects. */
|
||
{
|
||
return TCL_OK;
|
||
}
|
||
+
|
||
+/*
|
||
+ *----------------------------------------------------------------------
|
||
+ *
|
||
+ * TestpurebytesobjObjCmd --
|
||
+ *
|
||
+ * This object-based procedure constructs a pure bytes object
|
||
+ * without type and with internal representation containing NULL's.
|
||
+ *
|
||
+ * If no argument supplied it returns empty object with tclEmptyStringRep,
|
||
+ * otherwise it returns this as pure bytes object with bytes value equal
|
||
+ * string.
|
||
+ *
|
||
+ * Results:
|
||
+ * Returns the TCL_OK result code.
|
||
+ *
|
||
+ * Side effects:
|
||
+ * None.
|
||
+ *
|
||
+ *----------------------------------------------------------------------
|
||
+ */
|
||
+
|
||
+static int
|
||
+TestpurebytesobjObjCmd(
|
||
+ ClientData unused, /* Not used. */
|
||
+ Tcl_Interp *interp, /* Current interpreter. */
|
||
+ int objc, /* Number of arguments. */
|
||
+ Tcl_Obj *const objv[]) /* The argument objects. */
|
||
+{
|
||
+ Tcl_Obj *objPtr;
|
||
+
|
||
+ if (objc > 2) {
|
||
+ Tcl_WrongNumArgs(interp, 1, objv, "?string?");
|
||
+ return TCL_ERROR;
|
||
+ }
|
||
+ objPtr = Tcl_NewObj();
|
||
+ /*
|
||
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
|
||
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
|
||
+ */
|
||
+ memset(&objPtr->internalRep, 0, sizeof(objPtr->internalRep));
|
||
+ if (objc == 2) {
|
||
+ const char *s = Tcl_GetString(objv[1]);
|
||
+ objPtr->length = objv[1]->length;
|
||
+ objPtr->bytes = ckalloc(objPtr->length + 1);
|
||
+ memcpy(objPtr->bytes, s, objPtr->length);
|
||
+ objPtr->bytes[objPtr->length] = 0;
|
||
+ }
|
||
+ Tcl_SetObjResult(interp, objPtr);
|
||
+ return TCL_OK;
|
||
+}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* TestbytestringObjCmd --
|
||
|
||
Index: tests/basic.test
|
||
==================================================================
|
||
--- tests/basic.test
|
||
+++ tests/basic.test
|
||
@@ -959,10 +959,16 @@
|
||
lappend res [catch { run { {*}{error Hejsan} } } err]
|
||
lappend res $err
|
||
} -cleanup {
|
||
unset res t
|
||
} -result {0 10 1 Hejsan}
|
||
+
|
||
+test basic-48.24.$noComp {expansion: empty not canonical list, regression test, bug [cc1e91552c]} -constraints $constraints -setup {
|
||
+ unset -nocomplain a
|
||
+} -body {
|
||
+ run {list [list {*}{ }] [list {*}[format %c 32]] [list {*}[set a { }]]}
|
||
+} -result [lrepeat 3 {}] -cleanup {unset -nocomplain a}
|
||
|
||
} ;# End of noComp loop
|
||
|
||
test basic-49.1 {Tcl_EvalEx: verify TCL_EVAL_GLOBAL operation} testevalex {
|
||
set ::x global
|
||
|
||
Index: tests/lrange.test
|
||
==================================================================
|
||
--- tests/lrange.test
|
||
+++ tests/lrange.test
|
||
@@ -13,10 +13,16 @@
|
||
|
||
if {[lsearch [namespace children] ::tcltest] == -1} {
|
||
package require tcltest
|
||
namespace import -force ::tcltest::*
|
||
}
|
||
+
|
||
+::tcltest::loadTestedCommands
|
||
+catch [list package require -exact Tcltest [info patchlevel]]
|
||
+
|
||
+testConstraint testpurebytesobj [llength [info commands testpurebytesobj]]
|
||
+
|
||
|
||
test lrange-1.1 {range of list elements} {
|
||
lrange {a b c d} 1 2
|
||
} {b c}
|
||
test lrange-1.2 {range of list elements} {
|
||
@@ -105,14 +111,44 @@
|
||
list [lrange {a b c} -1 1] [lrange {a b c} -1+0 end-1] [lrange {a b c} -2 1] [lrange {a b c} -2+0 0+1]
|
||
} [lrepeat 4 {a b}]
|
||
test lrange-3.6 {compiled with calculated indices, end out of range (after end)} {
|
||
list [lrange {a b c} 1 end+1] [lrange {a b c} 1+0 2+1] [lrange {a b c} 1 end+1] [lrange {a b c} end-1 3+1]
|
||
} [lrepeat 4 {b c}]
|
||
+
|
||
+test lrange-3.7a {compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} {
|
||
+ list [lrange { } 0 1] [lrange [format %c 32] 0 1] [lrange [set a { }] 0 1] \
|
||
+ [lrange { } 0-1 end+1] [lrange [format %c 32] 0-1 end+1] [lrange $a 0-1 end+1]
|
||
+} [lrepeat 6 {}]
|
||
+test lrange-3.7b {not compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} {
|
||
+ set cmd lrange
|
||
+ list [$cmd { } 0 1] [$cmd [format %c 32] 0 1] [$cmd [set a { }] 0 1] \
|
||
+ [$cmd { } 0-1 end+1] [$cmd [format %c 32] 0-1 end+1] [$cmd $a 0-1 end+1]
|
||
+} [lrepeat 6 {}]
|
||
+# following 4 tests could cause a segfault on empty non-lists with tclEmptyStringRep
|
||
+# (as before the fix [58c46e74b931d3a1]):
|
||
+test lrange-3.7a.2 {compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} {
|
||
+ list [lrange {} 0 1] [lrange [lindex a -1] 0 1] [lrange [set a {}] 0 1] \
|
||
+ [lrange {} 0-1 end+1] [lrange [lindex a -1] 0-1 end+1] [lrange $a 0-1 end+1]
|
||
+} [lrepeat 6 {}]
|
||
+test lrange-3.7b.2 {not compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} {
|
||
+ set cmd lrange
|
||
+ list [$cmd {} 0 1] [$cmd [lindex a -1] 0 1] [$cmd [set a {}] 0 1] \
|
||
+ [$cmd {} 0-1 end+1] [$cmd [lindex a -1] 0-1 end+1] [$cmd $a 0-1 end+1]
|
||
+} [lrepeat 6 {}]
|
||
+test lrange-3.7c.2 {compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} {
|
||
+ list [lrange [testpurebytesobj] 0 1] [lrange [testpurebytesobj { }] 0 1] [lrange [set a [testpurebytesobj {}]] 0 1] \
|
||
+ [lrange [testpurebytesobj] 0-1 end+1] [lrange [testpurebytesobj { }] 0-1 end+1] [lrange $a 0-1 end+1]
|
||
+} [lrepeat 6 {}]
|
||
+test lrange-3.7d.2 {not compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} {
|
||
+ set cmd lrange
|
||
+ list [$cmd [testpurebytesobj] 0 1] [$cmd [testpurebytesobj { }] 0 1] [$cmd [set a [testpurebytesobj {}]] 0 1] \
|
||
+ [$cmd [testpurebytesobj] 0-1 end+1] [$cmd [testpurebytesobj { }] 0-1 end+1] [$cmd $a 0-1 end+1]
|
||
+} [lrepeat 6 {}]
|
||
|
||
|
||
# cleanup
|
||
::tcltest::cleanupTests
|
||
return
|
||
|
||
# Local Variables:
|
||
# mode: tcl
|
||
# End:
|
||
|