diff options
| -rw-r--r-- | doc/zipfs.n | 2 | ||||
| -rw-r--r-- | generic/tclZipfs.c | 14 | ||||
| -rw-r--r-- | tests/zipfs.test | 110 |
3 files changed, 118 insertions, 8 deletions
diff --git a/doc/zipfs.n b/doc/zipfs.n index ada0d28..a75a70b 100644 --- a/doc/zipfs.n +++ b/doc/zipfs.n @@ -84,7 +84,7 @@ Return a list of all files in the mounted zipfs, or just those matching \fIpattern\fR (optionally controlled by the option parameters). The order of the names in the list is arbitrary. .TP -\fBzipfs mount ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR? +\fBzipfs mount\fR ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR? . The \fBzipfs mount\fR command mounts a ZIP archive file as a Tcl virtual filesystem at \fImountpoint\fR. After this command executes, files contained diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index bf74823..d1d5deb 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -2424,21 +2424,21 @@ ZipFSMkZipOrImgObjCmd( list = objv[2]; Tcl_IncrRefCount(list); } else { - Tcl_Obj *cmd[3]; + Tcl_Obj *cmd[2]; + int result; /* * Discover the list of files to add. */ - cmd[1] = Tcl_NewStringObj("::tcl::zipfs::find", -1); - cmd[2] = objv[2]; - cmd[0] = Tcl_NewListObj(2, cmd + 1); + cmd[0] = Tcl_NewStringObj("::tcl::zipfs::find", -1); + cmd[1] = objv[2]; Tcl_IncrRefCount(cmd[0]); - if (Tcl_EvalObjEx(interp, cmd[0], TCL_EVAL_DIRECT) != TCL_OK) { - Tcl_DecrRefCount(cmd[0]); + result = Tcl_EvalObjv(interp, 2, cmd, 0); + Tcl_DecrRefCount(cmd[0]); + if (result != TCL_OK) { return TCL_ERROR; } - Tcl_DecrRefCount(cmd[0]); list = Tcl_GetObjResult(interp); Tcl_IncrRefCount(list); } diff --git a/tests/zipfs.test b/tests/zipfs.test index 8689268..3c11895 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -270,6 +270,116 @@ test zipfs-3.4 {zipfs in child interpreters} -constraints zipfs -setup { } -returnCodes error -cleanup { interp delete $safe } -result {not allowed to invoke subcommand mkzip of zipfs} + +test zipfs-4.1 {zipfs lmkimg} -constraints zipfs -setup { + set baseImage [makeFile "return sourceWorking\n\x1a" base] + set targetImage [makeFile "" target] + set addFile [makeFile "return mountWorking" add.data] + file delete $targetImage +} -body { + zipfs lmkimg $targetImage [list $addFile test/add.tcl] {} $baseImage + zipfs mount ziptest $targetImage + try { + list [source $targetImage] [source //zipfs:/ziptest/test/add.tcl] + } finally { + zipfs unmount ziptest + } +} -cleanup { + removeFile $baseImage + removeFile $targetImage + removeFile $addFile +} -result {sourceWorking mountWorking} +test zipfs-4.2 {zipfs lmkimg: making an image from an image} -constraints zipfs -setup { + set baseImage [makeFile "return sourceWorking\n\x1a" base_image.tcl] + set midImage [makeFile "" mid_image.tcl] + set targetImage [makeFile "" target_image.tcl] + set addFile [makeFile "return mountWorking" add.data] + file delete $midImage $targetImage +} -body { + zipfs lmkimg $midImage [list $addFile test/ko.tcl] {} $baseImage + zipfs lmkimg $targetImage [list $addFile test/ok.tcl] {} $midImage + zipfs mount ziptest $targetImage + try { + list [glob -tails -directory //zipfs://ziptest/test *.tcl] \ + [if {[file size $midImage] == [file size $targetImage]} { + string cat equal + } else { + list mid=[file size $midImage] target=[file size $targetImage] + }] + } finally { + zipfs unmount ziptest + } +} -cleanup { + removeFile $baseImage + removeFile $midImage + removeFile $targetImage + removeFile $addFile +} -result {ok.tcl equal} +test zipfs-4.3 {zipfs lmkimg: stripping password} -constraints zipfs -setup { + set baseImage [makeFile "return sourceWorking\n\x1a" base_image.tcl] + set midImage [makeFile "" mid_image.tcl] + set targetImage [makeFile "" target_image.tcl] + set addFile [makeFile "return mountWorking" add.data] + file delete $midImage $targetImage +} -body { + set pass gorp + zipfs lmkimg $midImage [list $addFile test/add.tcl] $pass $baseImage + zipfs lmkimg $targetImage [list $addFile test/ok.tcl] {} $midImage + zipfs mount ziptest $targetImage + try { + glob -tails -directory //zipfs://ziptest/test *.tcl + } finally { + zipfs unmount ziptest + } +} -cleanup { + removeFile $baseImage + removeFile $midImage + removeFile $targetImage + removeFile $addFile +} -result {ok.tcl} +test zipfs-4.4 {zipfs lmkimg: final password} -constraints zipfs -setup { + set baseImage [makeFile "return sourceWorking\n\x1a" base_image.tcl] + set midImage [makeFile "" mid_image.tcl] + set targetImage [makeFile "" target_image.tcl] + set addFile [makeFile "return mountWorking" add.data] + file delete $midImage $targetImage +} -body { + set pass gorp + zipfs lmkimg $midImage [list $addFile test/add.tcl] {} $baseImage + zipfs lmkimg $targetImage [list $addFile test/ok.tcl] $pass $midImage + zipfs mount ziptest $targetImage + try { + glob -tails -directory //zipfs://ziptest/test *.tcl + } finally { + zipfs unmount ziptest + } +} -cleanup { + removeFile $baseImage + removeFile $midImage + removeFile $targetImage + removeFile $addFile +} -result {ok.tcl} +test zipfs-4.5 {zipfs lmkimg: making image from mounted} -constraints zipfs -setup { + set baseImage [makeFile "return sourceWorking\n\x1a" base_image.tcl] + set midImage [makeFile "" mid_image.tcl] + set targetImage [makeFile "" target_image.tcl] + set addFile [makeFile "return mountWorking" add.data] + file delete $midImage $targetImage +} -body { + zipfs lmkimg $midImage [list $addFile test/add.tcl] {} $baseImage + zipfs mount ziptest $midImage + set f [glob -directory //zipfs://ziptest/test *.tcl] + zipfs lmkimg $targetImage [list $f test/ok.tcl] {} $midImage + zipfs unmount ziptest + zipfs mount ziptest $targetImage + list $f [glob -directory //zipfs://ziptest/test *.tcl] +} -cleanup { + zipfs unmount ziptest + removeFile $baseImage + removeFile $midImage + removeFile $targetImage + removeFile $addFile +} -result {//zipfs://ziptest/test/add.tcl //zipfs://ziptest/test/ok.tcl} ::tcltest::cleanupTests return |