Merge

5 files changed, 76 insertions, 47 deletions

diff --git a/generic/tclTest.c b/generic/tclTest.c
index 47b59c3..0f4289f 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -1182,6 +1182,9 @@ TestcmdinfoObjCmd(
 	info.objClientData = NULL;
 	info.deleteProc = CmdDelProc2;
 	info.deleteData = (void *) "new_delete_data";
+	info.namespacePtr = NULL;
+	info.objProc2 = NULL;
+	info.objClientData2 = NULL;
 	if (Tcl_SetCommandInfo(interp, Tcl_GetString(objv[2]), &info) == 0) {
 	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
 	} else {
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 248732b..64bfa1e 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -250,7 +250,10 @@ typedef struct ZipChannel {
     size_t numRead;		/* Position of next byte to be read from the
 				 * channel */
     unsigned char *ubuf;	/* Pointer to the uncompressed data */
-    int iscompr;		/* True if data is compressed */
+    unsigned char *ubufToFree;  /* NULL if ubuf points to memory that does not
+    				   need freeing. Else memory to free (ubuf
+				   may point *inside* the block) */
+    int iscompr;                /* True if data is compressed */
     int isDirectory;		/* Set to 1 if directory, or -1 if root */
     int isEncrypted;		/* True if data is encrypted */
     int isWriting;		/* True if open for writing */
@@ -1183,11 +1186,12 @@ ZipFSCloseArchive(
  *
  * Results:
  *	TCL_OK on success, TCL_ERROR otherwise with an error message placed
- *	into the given "interp" if it is not NULL.
+ *	into the given "interp" if it is not NULL. 
  *
  * Side effects:
- *	The given ZipFile struct is filled with information about the ZIP
- *	archive file.
+ *      The given ZipFile struct is filled with information about the ZIP
+ *      archive file.  On error, ZipFSCloseArchive is called on zf but 
+ *      it is not freed.
  *
  *-------------------------------------------------------------------------
  */
@@ -1389,7 +1393,8 @@ ZipFSFindTOC(
  *
  * Results:
  *	TCL_OK on success, TCL_ERROR otherwise with an error message placed
- *	into the given "interp" if it is not NULL.
+ *	into the given "interp" if it is not NULL. On error, ZipFSCloseArchive
+ *      is called on zf but it is not freed.
  *
  * Side effects:
  *	ZIP archive is memory mapped or read into allocated memory, the given
@@ -1612,7 +1617,7 @@ IsPasswordValid(
  *
  * Results:
  *	TCL_OK on success, TCL_ERROR otherwise with an error message placed
- *	into the given "interp" if it is not NULL.
+ *	into the given "interp" if it is not NULL. On error, frees zf!!
  *
  * Side effects:
  *	Will acquire and release the write lock.
@@ -1645,6 +1650,8 @@ ZipFSCatalogFilesystem(
     if (passwd) {
 	pwlen = strlen(passwd);
 	if (IsPasswordValid(interp, passwd, pwlen) != TCL_OK) {
+	    ZipFSCloseArchive(interp, zf);
+	    ckfree(zf);
 	    return TCL_ERROR;
 	}
     }
@@ -2099,6 +2106,7 @@ TclZipfs_Mount(
     }
     if (ZipFSCatalogFilesystem(interp, zf, mountPoint, passwd, zipname)
 	    != TCL_OK) {
+	/* zf would have been freed! */
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -2131,7 +2139,6 @@ TclZipfs_MountBuffer(
     int copy)
 {
     ZipFile *zf;
-    int result;
 
     ReadLock();
     if (!ZipFS.initialized) {
@@ -2173,6 +2180,8 @@ TclZipfs_MountBuffer(
     if (copy) {
 	zf->data = (unsigned char *) attemptckalloc(datalen);
 	if (!zf->data) {
+	    ZipFSCloseArchive(interp, zf);
+	    ckfree(zf);
 	    ZIPFS_MEM_ERROR(interp);
 	    return TCL_ERROR;
 	}
@@ -2183,11 +2192,12 @@ TclZipfs_MountBuffer(
 	zf->ptrToFree = NULL;
     }
     if (ZipFSFindTOC(interp, 1, zf) != TCL_OK) {
+	ckfree(zf);
 	return TCL_ERROR;
     }
-    result = ZipFSCatalogFilesystem(interp, zf, mountPoint, NULL,
-	    "Memory Buffer");
-    return result;
+    /* Note ZipFSCatalogFilesystem will free zf on error */
+    return ZipFSCatalogFilesystem(
+	interp, zf, mountPoint, NULL, "Memory Buffer");
 }
 
 /*
@@ -4089,20 +4099,19 @@ ZipChannelClose(
 	return EINVAL;
     }
 
-    if (info->iscompr && info->ubuf) {
-	ckfree(info->ubuf);
-	info->ubuf = NULL;
-    }
     if (info->isEncrypted) {
 	info->isEncrypted = 0;
 	memset(info->keys, 0, sizeof(info->keys));
     }
     if (info->isWriting) {
 	ZipEntry *z = info->zipEntryPtr;
-	unsigned char *newdata = (unsigned char *)
-		attemptckrealloc(info->ubuf, info->numRead);
+	assert(info->ubufToFree && info->ubuf);
+	unsigned char *newdata =
+	    (unsigned char *)attemptckrealloc(info->ubufToFree, info->numRead);
 
 	if (newdata) {
+	    info->ubufToFree = NULL;/* Now newdata! */
+	    info->ubuf = NULL;
 	    if (z->data) {
 		ckfree(z->data);
 	    }
@@ -4114,13 +4123,17 @@ ZipChannelClose(
 	    z->isEncrypted = 0;
 	    z->offset = 0;
 	    z->crc32 = 0;
-	} else {
-	    ckfree(info->ubuf);
 	}
     }
     WriteLock();
     info->zipFilePtr->numOpen--;
     Unlock();
+    if (info->ubufToFree) {
+	assert(info->ubuf);
+	ckfree(info->ubufToFree);
+	info->ubuf = NULL;
+	info->ubufToFree = NULL;
+    }
     ckfree(info);
     return TCL_OK;
 }
@@ -4490,7 +4503,9 @@ ZipChannelOpen(
 	flags |= TCL_READABLE;
 	info->numBytes = z->numBytes;
 	info->ubuf = z->data;
-    } else {
+	info->ubufToFree = NULL; /* Not dynamically allocated */
+    }
+    else {
 	/*
 	 * Set up a readable channel.
 	 */
@@ -4571,7 +4586,8 @@ InitWritableChannel(
     info->isWriting = 1;
     info->maxWrite = ZipFS.wrmax;
 
-    info->ubuf = (unsigned char *) attemptckalloc(info->maxWrite);
+    info->ubufToFree = (unsigned char *) attemptckalloc(info->maxWrite);
+    info->ubuf = info->ubufToFree;
     if (!info->ubuf) {
 	goto memoryError;
     }
@@ -4682,22 +4698,23 @@ InitWritableChannel(
     return TCL_OK;
 
   memoryError:
-    if (info->ubuf) {
-	ckfree(info->ubuf);
-    }
     ZIPFS_MEM_ERROR(interp);
-    return TCL_ERROR;
+    goto error_cleanup;
 
   corruptionError:
     if (cbuf) {
 	memset(info->keys, 0, sizeof(info->keys));
 	ckfree(cbuf);
     }
-    if (info->ubuf) {
-	ckfree(info->ubuf);
-    }
     ZIPFS_ERROR(interp, "decompression error");
     ZIPFS_ERROR_CODE(interp, "CORRUPT");
+
+  error_cleanup:
+    if (info->ubufToFree) {
+	ckfree(info->ubufToFree);
+	info->ubufToFree = NULL;
+	info->ubuf = NULL;
+    }
     return TCL_ERROR;
 }
 
@@ -4733,6 +4750,7 @@ InitReadableChannel(
 
     info->iscompr = (z->compressMethod == ZIP_COMPMETH_DEFLATED);
     info->ubuf = z->zipFilePtr->data + z->offset;
+    info->ubufToFree = NULL; /* ubuf memory not allocated */
     info->isDirectory = z->isDirectory;
     info->isEncrypted = z->isEncrypted;
 
@@ -4776,7 +4794,6 @@ InitReadableChannel(
 	    stream.avail_in -= 12;
 	    ubuf = (unsigned char *) attemptckalloc(stream.avail_in);
 	    if (!ubuf) {
-		info->ubuf = NULL;
 		goto memoryError;
 	    }
 
@@ -4788,8 +4805,10 @@ InitReadableChannel(
 	} else {
 	    stream.next_in = info->ubuf;
 	}
-	stream.next_out = info->ubuf = (unsigned char *)
+	info->ubufToFree = (unsigned char *)
 		attemptckalloc(info->numBytes);
+	info->ubuf = info->ubufToFree;
+	stream.next_out = info->ubuf;
 	if (!info->ubuf) {
 	    goto memoryError;
 	}
@@ -4833,31 +4852,32 @@ InitReadableChannel(
 	    ch = info->ubuf[j];
 	    ubuf[j] = zdecode(info->keys, crc32tab, ch);
 	}
-	info->ubuf = ubuf;
+	info->ubufToFree = ubuf;
+	info->ubuf = info->ubufToFree;
+	ubuf = NULL; /* So it does not inadvertently get free on future changes */
 	info->isEncrypted = 0;
     }
     return TCL_OK;
 
   corruptionError:
-    if (ubuf) {
-	info->isEncrypted = 0;
-	memset(info->keys, 0, sizeof(info->keys));
-	ckfree(ubuf);
-    }
-    if (info->ubuf) {
-	ckfree(info->ubuf);
-    }
     ZIPFS_ERROR(interp, "decompression error");
     ZIPFS_ERROR_CODE(interp, "CORRUPT");
-    return TCL_ERROR;
+    goto error_cleanup;
 
   memoryError:
+    ZIPFS_MEM_ERROR(interp);
+
+  error_cleanup:
     if (ubuf) {
-	info->isEncrypted = 0;
 	memset(info->keys, 0, sizeof(info->keys));
 	ckfree(ubuf);
     }
-    ZIPFS_MEM_ERROR(interp);
+    if (info->ubufToFree) {
+	ckfree(info->ubufToFree);
+	info->ubufToFree = NULL;
+	info->ubuf = NULL;
+    }
+
     return TCL_ERROR;
 }
 
diff --git a/tests/tcltests.tcl b/tests/tcltests.tcl
index 67c6bf9..409a2cc 100644
--- a/tests/tcltests.tcl
+++ b/tests/tcltests.tcl
@@ -69,6 +69,7 @@ namespace eval ::tcltests {
     #  testnumargs "zipfs mount" "" "?mountpoint? ?zipfile? ?password?"
     #  testnumargs "lappend" "varName" "?value ...?"
     proc testnumargs {cmd {fixed {}} {optional {}} args} {
+	variable count
         set minargs [llength $fixed]
         set maxargs [expr {$minargs + [llength $optional]}]
         if {[regexp {\.\.\.\??$} [lindex $optional end]]} {
@@ -89,12 +90,14 @@ namespace eval ::tcltests {
         set label [join $cmd -]
         if {$minargs > 0} {
             set arguments [lrepeat [expr {$minargs-1}] x]
-            test $label-minargs-1 "$label no arguments" \
+            test $label-minargs-[incr count($label-minargs)] \
+		"$label no arguments" \
                 -body "$cmd" \
                 -result $message -returnCodes error \
                 {*}$args
             if {$minargs > 1} {
-                test $label-minargs-1 "$label missing arguments" \
+                test $label-minargs-[incr count($label-minargs)] \
+		    "$label missing arguments" \
                     -body "$cmd $arguments" \
                     -result $message -returnCodes error \
                     {*}$args
@@ -102,7 +105,8 @@ namespace eval ::tcltests {
         }
         if {[info exists maxargs]} {
             set arguments [lrepeat [expr {$maxargs+1}] x]
-            test $label-maxargs-1 "$label extra arguments" \
+            test $label-maxargs-[incr count($label-maxargs)] \
+		"$label extra arguments" \
                 -body "$cmd $arguments" \
                 -result $message -returnCodes error \
                 {*}$args
diff --git a/tests/winPipe.test b/tests/winPipe.test
index 28d4f5b..2827595 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -616,6 +616,7 @@ removeFile nothing
 if {[info exists path(echoArgs.tcl)]} { removeFile echoArgs.tcl }
 if {[info exists path(echoArgs.bat)]} { removeFile echoArgs.bat }
 if {[info exists path(echoArgs2.bat)]} { removeDirectory test(Dir)Check }
+unset -nocomplain path
 ::tcltest::cleanupTests
 # back to original directory:
 cd $org_pwd; unset org_pwd
diff --git a/tests/zipfs.test b/tests/zipfs.test
index 11fd306..c99e1a5 100644
--- a/tests/zipfs.test
+++ b/tests/zipfs.test
@@ -791,6 +791,7 @@ namespace eval test_ns_zipfs {
         test.zip testmountA test.zip testmountB/subdir
     } {}
 
+    variable path
     testzipfsfind absolute-path    [file join [zipfs root] testmountA] {
         test.zip testmountA test.zip testmountB/subdir
     } [lmap path {
@@ -914,7 +915,7 @@ namespace eval test_ns_zipfs {
     testzipfscanonical drivepath X:/foo/bar [file join [zipfs root] foo bar] -constraints win
     # (backslashes need additional escaping passed to testzipfscanonical)
     testzipfscanonical backslashes X:\\\\foo\\\\bar [file join [zipfs root] foo bar] -constraints win
-    testzipfscanonical backslashes X:/foo\\\\bar [file join [zipfs root] foo bar] -constraints win
+    testzipfscanonical backslashes-1 X:/foo\\\\bar [file join [zipfs root] foo bar] -constraints win
 
 
 
@@ -1045,13 +1046,13 @@ namespace eval test_ns_zipfs {
         mount [zippath test.zip]
     } -cleanup cleanup -body {
         lsort -stride 2 [file stat [file join $defaultMountPoint test]]
-    } -result [fixupstat {atime 1065435402 ctime 1065435402 dev 0 gid 0 ino 0 mode 33133 mtime 1065435402 nlink 0 size 5 type file uid 0}]
+    } -result [fixupstat {atime 1065435402 ctime 1065435402 dev 0 gid 0 ino 0 mode 33133 mtime 1065435402 nlink 0 size 5 type file uid 0}] -constraints bug-3f9f494cc1
 
     test zipfs-file-stat-dir "Read stat of dir" -setup {
         mount [zippath test.zip]
     } -cleanup cleanup -body {
         lsort -stride 2 [file stat [file join $defaultMountPoint testdir]]
-    } -result [fixupstat {atime 1105450434 ctime 1105450434 dev 0 gid 0 ino 0 mode 16749 mtime 1105450434 nlink 0 size 0 type directory uid 0}]
+    } -result [fixupstat {atime 1105450434 ctime 1105450434 dev 0 gid 0 ino 0 mode 16749 mtime 1105450434 nlink 0 size 0 type directory uid 0}] -constraints bug-3f9f494cc1
 
     test zipfs-file-stat-mount "Read stat of mount point" -setup {
         mount [zippath test.zip]