Index: test/zipfile.test ================================================================== --- test/zipfile.test +++ test/zipfile.test @@ -7,10 +7,12 @@ # May you find forgiveness for yourself and forgive others. # May you share freely, never taking more than you give. # #*********************************************************************** # + +package require Tcl 8.6 set testdir [file dirname $argv0] source $testdir/tester.tcl set testprefix zipfile @@ -18,10 +20,14 @@ finish_test; return } if {[catch {load_static_extension db zipfile} error]} { puts "Skipping zipfile tests, hit load error: $error" finish_test; return +} +if {[catch {load_static_extension db fileio} error]} { + puts "Skipping zipfile tests, hit load error: $error" + finish_test; return } proc readfile {f} { set fd [open $f] fconfigure $fd -translation binary -encoding binary @@ -28,20 +34,43 @@ set data [read $fd] close $fd set data } -if {$::tcl_platform(platform)=="unix" && [catch {exec unzip}]==0} { - set ::UNZIP 1 - load_static_extension db fileio +unset -nocomplain ::UNZIP + +if {[catch {exec unzip} msg]==0 && \ + [regexp -line {^UnZip \d+\.\d+ .*? Info-ZIP\.} $msg]} { + set ::UNZIP unzip + proc fix_stat_mode {name mode} { + if {$::tcl_platform(platform)=="windows"} { + # + # NOTE: Set or unset the write bits of the file permissions + # based on the read-only attribute because the Win32 + # version of UnZip does this. + # + set writebits 0x12; # 0o22 + set result $mode + if {[file attributes $name -readonly]} { + set result [expr {$result | $writebits}] + } else { + set result [expr {$result & ~$writebits}] + } + return $result + } else { + return $mode + } + } proc do_unzip {file} { forcedelete test_unzip file mkdir test_unzip - exec unzip -d test_unzip $file - - set res [db eval { - SELECT replace(name,'test_unzip/',''),mode,mtime,data + exec $::UNZIP -d test_unzip $file + + db func modefix fix_stat_mode + + set res [db eval { + SELECT replace(name,'test_unzip/',''),modefix(name,mode),mtime,data FROM fsdir('test_unzip') WHERE name!='test_unzip' ORDER BY name }] set res @@ -106,11 +135,10 @@ # # Then tests that unpacking the new archive using [unzip] produces # the same results as in (1). # proc do_unzip_test {tn file} { - if {[info vars ::UNZIP]==""} { return } db func sss strip_slash db eval { SELECT writefile('test_unzip.zip', ( SELECT zipfile(name,mode,mtime,data,method) FROM zipfile($file) ) @@ -244,80 +272,88 @@ } { f.txt 33188 1000000000 abcde 0 h.txt 33188 1000000004 aaaaaaaaaabbbbbbbbbb 8 i.txt 33188 4 zxcvb 0 } + +if {$::tcl_platform(platform)=="unix"} { + set modes -rw-r--r-x + set perms 33189 +} else { + set modes -rw-r--r--; # no execute bits on Win32 + set perms 33188 +} do_execsql_test 1.6.3 { - UPDATE zz SET mode='-rw-r--r-x' WHERE name='h.txt'; + UPDATE zz SET mode=$modes WHERE name='h.txt'; SELECT name, mode, mtime, data, method FROM zipfile('test.zip'); -} { +} [string map [list %perms% $perms] { f.txt 33188 1000000000 abcde 0 - h.txt 33189 1000000004 aaaaaaaaaabbbbbbbbbb 8 + h.txt %perms% 1000000004 aaaaaaaaaabbbbbbbbbb 8 i.txt 33188 4 zxcvb 0 -} +}] do_zip_tests 1.6.3a test.zip do_execsql_test 1.6.4 { UPDATE zz SET name = 'blue.txt' WHERE name='f.txt'; SELECT name, mode, mtime, data, method FROM zipfile('test.zip'); -} { +} [string map [list %perms% $perms] { blue.txt 33188 1000000000 abcde 0 - h.txt 33189 1000000004 aaaaaaaaaabbbbbbbbbb 8 + h.txt %perms% 1000000004 aaaaaaaaaabbbbbbbbbb 8 i.txt 33188 4 zxcvb 0 -} +}] do_zip_tests 1.6.4a test.zip do_execsql_test 1.6.5 { UPDATE zz SET data = 'edcba' WHERE name='blue.txt'; SELECT name, mode, mtime, data, method FROM zipfile('test.zip'); -} { +} [string map [list %perms% $perms] { blue.txt 33188 1000000000 edcba 0 - h.txt 33189 1000000004 aaaaaaaaaabbbbbbbbbb 8 + h.txt %perms% 1000000004 aaaaaaaaaabbbbbbbbbb 8 i.txt 33188 4 zxcvb 0 -} +}] do_execsql_test 1.6.6 { UPDATE zz SET mode=NULL, data = NULL WHERE name='blue.txt'; SELECT name, mode, mtime, data, method FROM zipfile('test.zip'); -} { +} [string map [list %perms% $perms] { blue.txt/ 16877 1000000000 {} 0 - h.txt 33189 1000000004 aaaaaaaaaabbbbbbbbbb 8 + h.txt %perms% 1000000004 aaaaaaaaaabbbbbbbbbb 8 i.txt 33188 4 zxcvb 0 -} +}] do_catchsql_test 1.6.7 { UPDATE zz SET data=NULL WHERE name='i.txt' } {1 {zipfile: mode does not match data}} do_execsql_test 1.6.8 { SELECT name, mode, mtime, data, method FROM zipfile('test.zip'); -} { +} [string map [list %perms% $perms] { blue.txt/ 16877 1000000000 {} 0 - h.txt 33189 1000000004 aaaaaaaaaabbbbbbbbbb 8 + h.txt %perms% 1000000004 aaaaaaaaaabbbbbbbbbb 8 i.txt 33188 4 zxcvb 0 -} +}] -do_execsql_test 1.6.8 { +do_execsql_test 1.6.9 { UPDATE zz SET data = '' WHERE name='i.txt'; SELECT name,mode,mtime,data,method from zipfile('test.zip'); -} { +} [string map [list %perms% $perms] { blue.txt/ 16877 1000000000 {} 0 - h.txt 33189 1000000004 aaaaaaaaaabbbbbbbbbb 8 + h.txt %perms% 1000000004 aaaaaaaaaabbbbbbbbbb 8 i.txt 33188 4 {} 0 -} +}] -do_execsql_test 1.6.9 { +do_execsql_test 1.6.10 { SELECT a.name, a.data FROM zz AS a, zz AS b WHERE a.name=+b.name AND +a.mode=b.mode } { blue.txt/ {} h.txt aaaaaaaaaabbbbbbbbbb i.txt {} } -do_execsql_test 1.6.10 { +do_execsql_test 1.6.11 { SELECT name, data FROM zz WHERE name LIKE '%txt' } { h.txt aaaaaaaaaabbbbbbbbbb i.txt {} } @@ -358,17 +394,22 @@ dirname2/ 16877 {} dirname2/file1.txt 33188 abcdefghijklmnop } do_zip_tests 2.4a test.zip -# If on unix, check that the [unzip] utility can unpack our archive. +# Check that the [unzip] utility can unpack our archive. # -if {$::tcl_platform(platform)=="unix"} { +if {[info exists ::UNZIP]} { do_test 2.5.1 { forcedelete dirname forcedelete dirname2 - set rc [catch { exec unzip test.zip > /dev/null } msg] + if {$::tcl_platform(platform)=="unix"} { + set null /dev/null + } else { + set null NUL + } + set rc [catch { exec $::UNZIP test.zip > $null } msg] list $rc $msg } {0 {}} do_test 2.5.2 { file isdir dirname3 } 1 do_test 2.5.3 { file isdir dirname2 } 1 do_test 2.5.4 { file isdir dirname2/file1.txt } 0 @@ -382,10 +423,11 @@ #------------------------------------------------------------------------- reset_db forcedelete test.zip load_static_extension db zipfile +load_static_extension db fileio do_execsql_test 3.0 { CREATE VIRTUAL TABLE temp.x1 USING zipfile('test.zip'); INSERT INTO x1(name, data) VALUES('dir1/', NULL); INSERT INTO x1(name, data) VALUES('file1', '1234'); @@ -451,20 +493,20 @@ SELECT NULL, 'def' ) SELECT zipfile(name,data) FROM c } {1 {first argument to zipfile() must be non-NULL}} -do_catchsql_test 4.7 { +do_catchsql_test 4.8 { WITH c(name,data,method) AS ( SELECT 'a.txt', 'abc', 0 UNION SELECT 'b.txt', 'def', 8 UNION SELECT 'c.txt', 'ghi', 16 ) SELECT zipfile(name,NULL,NULL,data,method) FROM c } {1 {illegal method value: 16}} -do_catchsql_test 4.8 { +do_catchsql_test 4.9 { WITH c(name,data) AS ( SELECT 'a.txt', 'abc' UNION SELECT 'b.txt', 'def' UNION SELECT 'c.txt/', 'ghi' ) @@ -483,13 +525,12 @@ ) } { a.txt 946684800 abc } -if {[info vars ::UNZIP]!=""} { +if {[info exists ::UNZIP]} { ifcapable datetime { - load_static_extension db fileio forcedelete test1.zip test2.zip do_test 6.0 { execsql { WITH c(name,mtime,data) AS ( SELECT 'a.txt', 946684800, 'abc' UNION ALL @@ -500,11 +541,11 @@ writefile('test2.zip', ( zipfile(name, NULL, mtime, data) ) ) FROM c; } forcedelete test_unzip file mkdir test_unzip - exec unzip -d test_unzip test1.zip + exec $::UNZIP -d test_unzip test1.zip db eval { SELECT name, strftime('%s', mtime, 'unixepoch', 'localtime') FROM fsdir('test_unzip') WHERE name!='test_unzip' ORDER BY name @@ -532,11 +573,11 @@ } do_test 6.2 { forcedelete test_unzip file mkdir test_unzip - exec unzip -d test_unzip test2.zip + exec $::UNZIP -d test_unzip test2.zip db eval { SELECT name, mtime FROM fsdir('test_unzip') WHERE name!='test_unzip' ORDER BY name @@ -650,10 +691,12 @@ # catch {db close} forcedelete test.zip test.db sqlite3 db :memory: load_static_extension db zipfile +load_static_extension db fileio + do_execsql_test 10.0 { CREATE VIRTUAL TABLE z USING zipfile('test.zip'); } {} do_catchsql_test 10.1 { INSERT INTO z(name,data) VALUES('a0','one'),('a0','two'); Index: test/zipfile2.test ================================================================== --- test/zipfile2.test +++ test/zipfile2.test @@ -7,10 +7,12 @@ # May you find forgiveness for yourself and forgive others. # May you share freely, never taking more than you give. # #*********************************************************************** # + +package require Tcl 8.6 set testdir [file dirname $argv0] source $testdir/tester.tcl set testprefix zipfile2