Merge 8.6

4 files changed, 87 insertions, 6 deletions

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index c8f09f5..036f422 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1454,7 +1454,7 @@ CompileExprObj(
      */
 
     ByteCodeGetIntRep(objPtr, &exprCodeType, codePtr);
-    
+
     if (codePtr != NULL) {
 	Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
 
@@ -4964,7 +4964,7 @@ TEBCresume(
 	/* Every range of an empty list is an empty list */
 	if (objc == 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);
 	    }
diff --git a/generic/tclTest.c b/generic/tclTest.c
index f97ba6d..3ebd91d 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -227,6 +227,9 @@ static int		TestasyncCmd(void *dummy,
 static int		TestbytestringObjCmd(void *clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+static int		TestpurebytesobjObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 static int		TeststringbytesObjCmd(void *clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -247,8 +250,8 @@ static int		TestdelCmd(void *dummy,
 static int		TestdelassocdataCmd(void *dummy,
 			    Tcl_Interp *interp, int argc, const char **argv);
 static int		TestdoubledigitsObjCmd(void *dummy,
-					       Tcl_Interp* interp,
-					       int objc, Tcl_Obj* const objv[]);
+			    Tcl_Interp* interp, int objc,
+			    Tcl_Obj* const objv[]);
 static int		TestdstringCmd(void *dummy,
 			    Tcl_Interp *interp, int argc, const char **argv);
 static int		TestencodingObjCmd(void *dummy,
@@ -579,6 +582,7 @@ Tcltest_Init(
     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, "teststringbytes", TeststringbytesObjCmd, NULL, NULL);
     Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
@@ -2095,7 +2099,7 @@ TestevalexObjCmd(
 
     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);
@@ -4937,6 +4941,57 @@ TeststringbytesObjCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * 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 --
  *
  *	This object-based procedure constructs a string which can
diff --git a/tests/lrange.test b/tests/lrange.test
index e12e1a4..dcc0eec 100644
--- a/tests/lrange.test
+++ b/tests/lrange.test
@@ -15,6 +15,12 @@ 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
@@ -116,6 +122,26 @@ test lrange-3.7b {not compiled on empty not canonical list (with static and dyna
     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 {}]
 
 test lrange-4.1 {lrange pure promise} -body {
     set ll1 [list $tcl_version 2 3 4]
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index 42a0d07..80e3f10 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -572,7 +572,7 @@ TestplatformChmod(
      */
 
     if (set_readOnly == acl_readOnly_found || SetNamedSecurityInfoA(
-	    (LPSTR) nativePath, SE_FILE_OBJECT, 
+	    (LPSTR) nativePath, SE_FILE_OBJECT,
 	    DACL_SECURITY_INFORMATION /*| PROTECTED_DACL_SECURITY_INFORMATION*/,
 	    NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
 	res = 0;