From 2ffdc34f060066397dea6b1c3318727e8bf2c930783023ba4a726d9823015b47 Mon Sep 17 00:00:00 2001 From: Reinhard Max Date: Thu, 17 Jan 2019 13:24:26 +0000 Subject: [PATCH] OBS-URL: https://build.opensuse.org/package/show/devel:languages:tcl/tcl?expand=0&rev=114 --- tcl-expand-regression.patch | 147 +++++++++++++++++++++++++++++++++++- tcl.changes | 2 +- 2 files changed, 146 insertions(+), 3 deletions(-) diff --git a/tcl-expand-regression.patch b/tcl-expand-regression.patch index 09791d5..43d79af 100644 --- a/tcl-expand-regression.patch +++ b/tcl-expand-regression.patch @@ -11,7 +11,7 @@ Index: generic/tclExecute.c - TRACE_APPEND(("\n")); - NEXT_INST_F(9, 0, 0); + /* avoid return of not canonical list (e. g. spaces in string repr.) */ -+ if (ListObjIsCanonical(valuePtr)) { ++ if (!valuePtr->bytes || !valuePtr->bytes[0]) { + TRACE_APPEND(("\n")); + NEXT_INST_F(9, 0, 0); + } @@ -22,6 +22,112 @@ Index: generic/tclExecute.c /* +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 @@ -48,7 +154,24 @@ Index: tests/lrange.test ================================================================== --- tests/lrange.test +++ tests/lrange.test -@@ -105,14 +105,24 @@ +@@ -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)} { @@ -63,6 +186,26 @@ Index: tests/lrange.test + 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 {}] diff --git a/tcl.changes b/tcl.changes index f3c22ca..0732fdf 100644 --- a/tcl.changes +++ b/tcl.changes @@ -1,5 +1,5 @@ ------------------------------------------------------------------- -Tue Jan 8 15:39:33 UTC 2019 - Reinhard Max +Thu Jan 17 09:22:56 UTC 2019 - Reinhard Max - Fix a regression in the handling of denormalized empty lists (tcl-expand-regression.patch, tcl#cc1e91552c).