# The file tests the tclZlib.c file. # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright © 1996-1998 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } testConstraint zipfs [expr { [llength [info commands zlib]] && [regexp tcltest [info nameofexecutable]] }] testConstraint zipfslib 1 set ziproot [zipfs root] set CWD [pwd] set tmpdir [file join $CWD tmp] file mkdir $tmpdir test zipfs-0.0 {zipfs basics} -constraints zipfs -body { package require tcl::zipfs } -result {2.0} test zipfs-0.1 {zipfs basics} -constraints zipfs -body { expr {${ziproot} in [file volumes]} } -result 1 if {![string match ${ziproot}* $tcl_library]} { ### # "make test" does not map tcl_library from the dynamic library on Unix # # Hack the environment to pretend we did pull tcl_library from a zip # archive ### set tclzip [file join $CWD libtcl[info patchlevel].zip] testConstraint zipfslib [file isfile $tclzip] if {[testConstraint zipfslib]} { zipfs mount $tclzip /lib/tcl set ::tcl_library ${ziproot}lib/tcl/tcl_library } } test zipfs-0.2 {zipfs basics} -constraints zipfslib -body { string match ${ziproot}* $tcl_library } -result 1 test zipfs-0.3 {zipfs basics: glob} -constraints zipfslib -setup { set pwd [pwd] } -body { cd $tcl_library expr { [file join . http] in [glob -dir . http*] } } -cleanup { cd $pwd } -result 1 test zipfs-0.4 {zipfs basics: glob} -constraints zipfslib -setup { set pwd [pwd] } -body { cd $tcl_library expr { [file join $tcl_library http] in [glob -dir [pwd] http*] } } -cleanup { cd $pwd } -result 1 test zipfs-0.5 {zipfs basics: glob} -constraints zipfslib -body { expr { [file join $tcl_library http] in [glob -dir $tcl_library http*] } } -result 1 test zipfs-0.6 {zipfs basics: glob} -constraints zipfslib -body { expr { [file join $tcl_library http] in [glob [file join $tcl_library http*]] } } -result 1 test zipfs-0.7 {zipfs basics: glob} -constraints zipfslib -body { expr { "http" in [glob -tails -dir $tcl_library http*] } } -result 1 test zipfs-0.8 {zipfs basics: glob} -constraints zipfslib -body { expr { "http" in [glob -nocomplain -tails -types d -dir $tcl_library http*] } } -result 1 test zipfs-0.9 {zipfs basics: glob} -constraints zipfslib -body { glob -nocomplain -tails -types f -dir $tcl_library http* } -result {} test zipfs-0.10 {zipfs basics: join} -constraints {zipfs zipfslib} -body { file join [zipfs root] bar baz } -result "[zipfs root]bar/baz" test zipfs-0.11 {zipfs basics: join} -constraints {zipfs zipfslib} -body { file normalize [zipfs root] } -result "[zipfs root]" test zipfs-0.12 {zipfs basics: join} -constraints {zipfs zipfslib} -body { file normalize [zipfs root]//bar/baz//qux/../ } -result "[zipfs root]bar/baz" test zipfs-1.3 {zipfs errors} -constraints zipfs -returnCodes error -body { zipfs mount a b c d e f } -result {wrong # args: should be "zipfs mount ?zipfile? ?mountpoint? ?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"} 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"} test zipfs-1.6 {zipfs errors} -constraints zipfs -returnCodes error -body { zipfs mkimg a b c d e f } -result {wrong # args: should be "zipfs mkimg outfile indir ?strip? ?password? ?infile?"} test zipfs-1.7 {zipfs errors} -constraints zipfs -returnCodes error -body { zipfs mkzip a b c d e f } -result {wrong # args: should be "zipfs mkzip outfile indir ?strip? ?password?"} test zipfs-1.8 {zipfs errors} -constraints zipfs -returnCodes error -body { zipfs exists a b c d e f } -result {wrong # args: should be "zipfs exists filename"} test zipfs-1.9 {zipfs errors} -constraints zipfs -returnCodes error -body { zipfs info a b c d e f } -result {wrong # args: should be "zipfs info filename"} test zipfs-1.10 {zipfs errors} -constraints zipfs -returnCodes error -body { zipfs list a b c d e f } -result {wrong # args: should be "zipfs list ?(-glob|-regexp)? ?pattern?"} file mkdir tmp test zipfs-2.1 {zipfs mkzip empty archive} -constraints zipfs -returnCodes error -body { zipfs mkzip [file join $tmpdir empty.zip] $tcl_library/xxxx } -result {empty archive} ### # The next series of tests operate within a zipfile created a temporary # directory. ### set zipfile [file join $tmpdir abc.zip] if {[file exists $zipfile]} { file delete $zipfile } test zipfs-2.2 {zipfs mkzip} -constraints zipfs -body { cd $tcl_library/encoding zipfs mkzip $zipfile . zipfs mount $zipfile ${ziproot}abc zipfs list -glob ${ziproot}abc/cp850.* } -cleanup { cd $CWD } -result "[zipfs root]abc/cp850.enc" testConstraint zipfsenc [zipfs exists /abc/cp850.enc] test zipfs-2.3 {zipfs info} -constraints {zipfs zipfsenc} -body { set r [zipfs info ${ziproot}abc/cp850.enc] lrange $r 0 2 } -result [list $zipfile 1090 527] ;# NOTE: Only the first 3 results are stable test zipfs-2.4 {zipfs data} -constraints {zipfs zipfsenc} -body { set zipfd [open ${ziproot}/abc/cp850.enc] ;# FIXME: leave open - see later test read $zipfd } -result {# Encoding file: cp850, single-byte S 003F 0 1 00 0000000100020003000400050006000700080009000A000B000C000D000E000F 0010001100120013001400150016001700180019001A001B001C001D001E001F 0020002100220023002400250026002700280029002A002B002C002D002E002F 0030003100320033003400350036003700380039003A003B003C003D003E003F 0040004100420043004400450046004700480049004A004B004C004D004E004F 0050005100520053005400550056005700580059005A005B005C005D005E005F 0060006100620063006400650066006700680069006A006B006C006D006E006F 0070007100720073007400750076007700780079007A007B007C007D007E007F 00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5 00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192 00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB 2591259225932502252400C100C200C000A9256325512557255D00A200A52510 25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4 00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580 00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4 00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0 } ;# FIXME: result depends on content of encodings dir test zipfs-2.5 {zipfs exists} -constraints {zipfs zipfsenc} -body { zipfs exists /abc/cp850.enc } -result 1 test zipfs-2.6 {zipfs unmount while busy} -constraints {zipfs zipfsenc} -body { zipfs unmount /abc } -returnCodes error -result {filesystem is busy} test zipfs-2.7 {zipfs unmount} -constraints {zipfs zipfsenc} -body { close $zipfd zipfs unmount /abc zipfs exists /abc/cp850.enc } -result 0 ### # Repeat the tests for a buffer mounted archive ### test zipfs-2.8 {zipfs mkzip} -constraints zipfs -body { cd $tcl_library/encoding zipfs mkzip $zipfile . set fin [open $zipfile r] fconfigure $fin -translation binary set dat [read $fin] close $fin zipfs mount_data def $dat zipfs list -glob ${ziproot}def/cp850.* } -cleanup { cd $CWD } -result "[zipfs root]def/cp850.enc" testConstraint zipfsencbuf [zipfs exists /def/cp850.enc] test zipfs-2.9 {zipfs info} -constraints {zipfs zipfsencbuf} -body { set r [zipfs info ${ziproot}def/cp850.enc] lrange $r 0 2 } -result [list {Memory Buffer} 1090 527] ;# NOTE: Only the first 3 results are stable test zipfs-2.10 {zipfs data} -constraints {zipfs zipfsencbuf} -body { set zipfd [open ${ziproot}/def/cp850.enc] ;# FIXME: leave open - see later test read $zipfd } -result {# Encoding file: cp850, single-byte S 003F 0 1 00 0000000100020003000400050006000700080009000A000B000C000D000E000F 0010001100120013001400150016001700180019001A001B001C001D001E001F 0020002100220023002400250026002700280029002A002B002C002D002E002F 0030003100320033003400350036003700380039003A003B003C003D003E003F 0040004100420043004400450046004700480049004A004B004C004D004E004F 0050005100520053005400550056005700580059005A005B005C005D005E005F 0060006100620063006400650066006700680069006A006B006C006D006E006F 0070007100720073007400750076007700780079007A007B007C007D007E007F 00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5 00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192 00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB 2591259225932502252400C100C200C000A9256325512557255D00A200A52510 25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4 00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580 00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4 00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0 } ;# FIXME: result depends on content of encodings dir test zipfs-2.11 {zipfs exists} -constraints {zipfs zipfsencbuf} -body { zipfs exists /def/cp850.enc } -result 1 test zipfs-2.12 {zipfs unmount while busy} -constraints {zipfs zipfsencbuf} -body { zipfs unmount /def } -returnCodes error -result {filesystem is busy} test zipfs-2.13 {zipfs unmount} -constraints {zipfs zipfsencbuf} -body { close $zipfd zipfs unmount /def zipfs exists /def/cp850.enc } -result 0 catch {file delete -force $tmpdir} test zipfs-3.1 {zipfs in child interpreters} -constraints zipfs -setup { set interp [interp create] } -body { interp eval $interp { zipfs ? } } -returnCodes error -cleanup { interp delete $interp } -result {unknown or ambiguous subcommand "?": must be canonical, exists, find, info, list, lmkimg, lmkzip, mkimg, mkkey, mkzip, mount, mount_data, root, or unmount} test zipfs-3.2 {zipfs in child interpreters} -constraints zipfs -setup { set interp [interp create] } -body { interp eval $interp { zipfs mkzip } } -returnCodes error -cleanup { interp delete $interp } -result {wrong # args: should be "zipfs mkzip outfile indir ?strip? ?password?"} test zipfs-3.3 {zipfs in child interpreters} -constraints zipfs -setup { set safe [interp create -safe] } -body { interp eval $safe { zipfs ? } } -returnCodes error -cleanup { interp delete $safe } -result {unknown or ambiguous subcommand "?": must be canonical, exists, find, info, list, lmkimg, lmkzip, mkimg, mkkey, mkzip, mount, mount_data, root, or unmount} test zipfs-3.4 {zipfs in child interpreters} -constraints zipfs -setup { set safe [interp create -safe] } -body { interp eval $safe { zipfs mkzip } } -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 $targetImage ziptest 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 $targetImage ziptest 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 $targetImage ziptest 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 $targetImage ziptest 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 $midImage ziptest set f [glob -directory /zipfs://ziptest/test *.tcl] zipfs lmkimg $targetImage [list $f test/ok.tcl] {} $midImage zipfs unmount ziptest zipfs mount $targetImage ziptest 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} test zipfs-5.1 {zipfs mount_data: short data} -constraints zipfs -body { zipfs mount_data gorp {} } -returnCodes error -result {bad zip data} test zipfs-5.2 {zipfs mount_data: short data} -constraints zipfs -body { zipfs mount_data gorp gorpGORPgorp } -returnCodes error -result {bad zip data} 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..................................... zipfs mount_data gorp $data } -returnCodes error -result {bad zip data} 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?"} test zipfs-6.1 {zipfs mkkey} -constraints zipfs -body { binary scan [zipfs mkkey gorp] cu* x return $x } -result {224 226 111 103 4 80 75 90 90} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: