merge core-8-branch

generic/tclStringObj.c

@@ -1227,6 +1227,7 @@ Tcl_AppendLimitedToObj(
      * force objPtr to unicode representation. See [7f1162a867] */
     if (bytes && ISCONTINUATION(bytes)) {
 	Tcl_GetUnicode(objPtr);
+	stringPtr = GET_STRING(objPtr);
     }
     if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
 	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
@@ -1430,6 +1431,7 @@ Tcl_AppendObjToObj(
      * This fixes append-3.4, append-3.7 and utf-1.18 testcases. */
     if (ISCONTINUATION(TclGetString(appendObjPtr))) {
 	Tcl_GetUnicode(objPtr);
+	stringPtr = GET_STRING(objPtr);
     }
     /*
      * If objPtr has a valid Unicode rep, then get a Unicode string from
@@ -3847,6 +3849,7 @@ TclStringReverse(
 
     if (stringPtr->hasUnicode) {
 	Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
+	stringPtr = GET_STRING(objPtr);
 	Tcl_UniChar *src = from + stringPtr->numChars;
 	Tcl_UniChar *to;
 
@@ -3859,6 +3862,7 @@ TclStringReverse(
 	    objPtr = Tcl_NewUnicodeObj(&ch, 1);
 	    Tcl_SetObjLength(objPtr, stringPtr->numChars);
 	    to = Tcl_GetUnicode(objPtr);
+	    stringPtr = GET_STRING(objPtr);
 	    while (--src >= from) {
 #if TCL_UTF_MAX < 4
 		ch = *src;

tests/safe-zipfs.test

@@ -51,11 +51,6 @@ proc mapAndSortList {map listIn} {
 # thus un-autoindexed) APIs in this test result arguments:
 catch {safe::interpConfigure}
 
-# testing that nested and statics do what is advertised (we use a
-# package - tcl::test - but it might be absent if we're in standard tclsh)
-
-testConstraint tcl::test [expr {![catch {package require tcl::test}]}]
-
 # Tests 5.* test the example files before using them to test safe interpreters.
 
 test safe-zipfs-5.1 {example tclIndex commands, test in parent interpreter; zipfs} -setup {

tests/zipfs.test

@@ -19,6 +19,7 @@ testConstraint zipfs [expr {
     [llength [info commands zlib]] && [regexp tcltest [info nameofexecutable]]
 }]
 testConstraint zipfslib 1
+testConstraint zipfscomments 0
 
 set ziproot [zipfs root]
 set CWD [pwd]
@@ -96,7 +97,7 @@ test zipfs-1.3 {zipfs errors} -constraints zipfs -returnCodes error -body {
 } -result {wrong # args: should be "zipfs mount ?mountpoint? ?zipfile? ?password?"}
 test zipfs-1.4 {zipfs errors} -constraints zipfs -returnCodes error -body {
     zipfs unmount a b c d e f
-} -result {wrong # args: should be "zipfs unmount zipfile"}
+} -result {wrong # args: should be "zipfs unmount mountpoint"}
 test zipfs-1.5 {zipfs errors} -constraints zipfs -returnCodes error -body {
     zipfs mkkey a b c d e f
 } -result {wrong # args: should be "zipfs mkkey password"}
@@ -380,6 +381,34 @@ test zipfs-4.5 {zipfs lmkimg: making image from mounted} -constraints zipfs -set
     removeFile $targetImage
     removeFile $addFile
 } -result {//zipfs://ziptest/test/add.tcl //zipfs://ziptest/test/ok.tcl}
+test zipfs-4.6 {zipfs lmkimg: making image with comment} -constraints {zipfs zipfscomments} -setup {
+    set baseImage [makeFile "return sourceWorking\n\x1A" base_image.tcl]
+    set targetImage [makeFile "" target_image.tcl]
+    set addFile [makeFile "return mountWorking" add.data]
+    file delete $midImage $targetImage
+    proc addComment {zipfile commentData} {
+	set len [binary format s [string length $commentData]]
+	set f [open $zipfile r+b]
+	try {
+	    chan seek $f -2 end
+	    puts -nonewline $f $len$commentData
+	} finally {
+	    close $f
+	}
+    }
+} -body {
+    zipfs lmkimg $targetImage [list $addFile test/ok.tcl] {} $baseImage
+    addComment $targetImage "gorp"
+    zipfs mount ziptest $targetImage
+    list [glob -directory //zipfs://ziptest/test *.tcl] \
+	[zipfs comment //zipfs://ziptest/]
+} -cleanup {
+    zipfs unmount ziptest
+    removeFile $baseImage
+    removeFile $midImage
+    removeFile $targetImage
+    removeFile $addFile
+} -result {//zipfs://ziptest/test/ok.tcl gorp}
 
 test zipfs-5.1 {zipfs mount_data: short data} -constraints zipfs -body {
     zipfs mount_data gorp {}
@@ -390,9 +419,15 @@ test zipfs-5.2 {zipfs mount_data: short data} -constraints zipfs -body {
 test zipfs-5.3 {zipfs mount_data: short data} -constraints zipfs -body {
     set data PK\x03\x04.....................................
     append data PK\x01\x02.....................................
-    append data PK\x05\x06.....................................
+    append data PK\x05\x06................\x01\x00...................
     zipfs mount_data gorp $data
 } -returnCodes error -result {bad zip data}
+test zipfs-5.4 {zipfs mount_data: short data} -constraints zipfs -body {
+    set data PK\x03\x04.....................................
+    append data PK\x01\x02.....................................
+    append data PK\x05\x06................\x00\x01...................
+    zipfs mount_data gorp $data
+} -returnCodes error -result {bad zip comment}
 test zipfs-5.4 {zipfs mount_data: bad arg count} -constraints zipfs -body {
     zipfs mount_data gorp {} foobar
 } -returnCodes error -result {wrong # args: should be "zipfs mount_data ?mountpoint? ?data?"}

win/rules.vc

@@ -1260,7 +1260,13 @@ tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)"
 
 # Various output paths
 PRJIMPLIB	= $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
-PRJLIBNAME	= $(PROJECT)$(VERSION)$(SUFX).$(EXT)
+PRJLIBNAME8	= $(PROJECT)$(VERSION)$(SUFX).$(EXT)
+PRJLIBNAME9	= tcl9$(PROJECT)$(VERSION)$(SUFX).$(EXT)
+!if $(TCL_MAJOR_VERSION) == 8
+PRJLIBNAME	= $(PRJLIBNAME8)
+!else
+PRJLIBNAME	= $(PRJLIBNAME9)
+!endif
 PRJLIB		= $(OUT_DIR)\$(PRJLIBNAME)
 
 PRJSTUBLIBNAME	= $(STUBPREFIX)$(VERSION).lib
@@ -1590,12 +1596,22 @@ default-target: $(DEFAULT_BUILD_TARGET)
 
 !if $(MULTIPLATFORM_INSTALL)
 default-pkgindex:
+	@echo if {[package vsatisfies [package provide Tcl] 9.0-]} { > $(OUT_DIR)\pkgIndex.tcl
 	@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
-	    [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl
+	    [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME9)]] >> $(OUT_DIR)\pkgIndex.tcl
+	@echo } else { >> $(OUT_DIR)\pkgIndex.tcl
+	@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
+	    [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME8)]] >> $(OUT_DIR)\pkgIndex.tcl
+	@echo } >> $(OUT_DIR)\pkgIndex.tcl
 !else
 default-pkgindex:
+	@echo if {[package vsatisfies [package provide Tcl] 9.0-]} { > $(OUT_DIR)\pkgIndex.tcl
 	@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
-	    [list load [file join $$dir $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl
+	    [list load [file join $$dir $(PRJLIBNAME9)]] >> $(OUT_DIR)\pkgIndex.tcl
+	@echo } else { >> $(OUT_DIR)\pkgIndex.tcl
+	@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
+	    [list load [file join $$dir $(PRJLIBNAME8)]] >> $(OUT_DIR)\pkgIndex.tcl
+	@echo } >> $(OUT_DIR)\pkgIndex.tcl
 !endif
 
 default-pkgindex-tea:
@@ -1604,6 +1620,8 @@ default-pkgindex-tea:
 @PACKAGE_NAME@       $(PRJ_PACKAGE_TCLNAME)
 @PACKAGE_TCLNAME@    $(PRJ_PACKAGE_TCLNAME)
 @PKG_LIB_FILE@       $(PRJLIBNAME)
+@PKG_LIB_FILE8@      $(PRJLIBNAME8)
+@PKG_LIB_FILE9@      $(PRJLIBNAME9)
 <<
 
 default-install: default-install-binaries default-install-libraries

win/tclWinTime.c

@@ -524,7 +524,7 @@ IsPerfCounterAvailable(void)
 		|| ((regs[0] & 0x00F00000)	/* Extended family */
 		&& (regs[3] & 0x10000000)))	/* Hyperthread */
 		&& (((regs[1]&0x00FF0000) >> 16)/* CPU count */
-			== (int)sy stemInfo.dwNumberOfProcessors)) {
+			== (int)systemInfo.dwNumberOfProcessors)) {
 	    timeInfo.perfCounterAvailable = TRUE;
 	} else {
 	    timeInfo.perfCounterAvailable = FALSE;