| # 2017 December 9 |
| # |
| # The author disclaims copyright to this source code. In place of |
| # a legal notice, here is a blessing: |
| # |
| # May you do good and not evil. |
| # May you find forgiveness for yourself and forgive others. |
| # May you share freely, never taking more than you give. |
| # |
| #*********************************************************************** |
| # |
| # Test the shell tool ".ar" command. |
| # |
| |
| set testdir [file dirname $argv0] |
| source $testdir/tester.tcl |
| set testprefix shell8 |
| |
| ifcapable !vtab { |
| finish_test; return |
| } |
| set CLI [test_cli_invocation] |
| |
| # Check to make sure the shell has been compiled with ".archive" support. |
| # |
| if {[string match {*unknown command*} [catchcmd :memory: .archive]]} { |
| finish_test; return |
| } |
| |
| proc populate_dir {dirname spec} { |
| # First delete the current tree, if one exists. |
| file delete -force $dirname |
| |
| # Recreate the root of the new tree. |
| file mkdir $dirname |
| |
| # Add each file to the new tree. |
| foreach {f d} $spec { |
| set path [file join $dirname $f] |
| file mkdir [file dirname $path] |
| set fd [open $path w] |
| puts -nonewline $fd $d |
| close $fd |
| } |
| } |
| |
| proc dir_content {dirname} { |
| lsort [glob -nocomplain $dirname/*] |
| } |
| |
| proc dir_to_list {dirname {n -1}} { |
| if {$n<0} {set n [llength [file split $dirname]]} |
| |
| set res [list] |
| foreach f [glob -nocomplain $dirname/*] { |
| set mtime [file mtime $f] |
| if {$::tcl_platform(platform)!="windows"} { |
| set perm [file attributes $f -perm] |
| } else { |
| set perm 0 |
| } |
| set relpath [file join {*}[lrange [file split $f] $n end]] |
| lappend res |
| if {[file isdirectory $f]} { |
| lappend res [list $relpath / $mtime $perm] |
| lappend res {*}[dir_to_list $f] |
| } else { |
| set fd [open $f] |
| set data [read $fd] |
| close $fd |
| lappend res [list $relpath $data $mtime $perm] |
| } |
| } |
| lsort $res |
| } |
| |
| proc dir_compare {d1 d2} { |
| set l1 [dir_to_list $d1] |
| set l2 [dir_to_list $d1] |
| string compare $l1 $l2 |
| } |
| |
| foreach {tn tcl} { |
| 1 { |
| set c1 ".ar c ar1" |
| set x1 ".ar x" |
| |
| set c2 ".ar cC ar1 ." |
| set x2 ".ar Cx ar3" |
| |
| set c3 ".ar cCf ar1 test_xyz.db ." |
| set x3 ".ar Cfx ar3 test_xyz.db" |
| } |
| |
| 2 { |
| set c1 ".ar -c ar1" |
| set x1 ".ar -x" |
| |
| set c2 ".ar -cC ar1 ." |
| set x2 ".ar -xC ar3" |
| |
| set c3 ".ar -cCar1 -ftest_xyz.db ." |
| set x3 ".ar -x -C ar3 -f test_xyz.db" |
| } |
| |
| 3 { |
| set c1 ".ar --create ar1" |
| set x1 ".ar --extract" |
| |
| set c2 ".ar --directory ar1 --create ." |
| set x2 ".ar --extract --dir ar3" |
| |
| set c3 ".ar --creat --dir ar1 --file test_xyz.db ." |
| set x3 ".ar --e --dir ar3 --f test_xyz.db" |
| } |
| |
| 4 { |
| set c1 ".ar --cr ar1" |
| set x1 ".ar --e" |
| |
| set c2 ".ar -C ar1 -c ." |
| set x2 ".ar -x -C ar3" |
| |
| set c3 ".ar -c --directory ar1 --file test_xyz.db ." |
| set x3 ".ar -x --directory ar3 --file test_xyz.db" |
| } |
| } { |
| eval $tcl |
| |
| # Populate directory "ar1" with some files. |
| # |
| populate_dir ar1 { |
| file1 "abcd" |
| file2 "efgh" |
| dir1/file3 "ijkl" |
| } |
| set expected [dir_to_list ar1] |
| |
| do_test 1.$tn.1 { |
| catchcmd test_ar.db $c1 |
| file delete -force ar1 |
| catchcmd test_ar.db $x1 |
| dir_to_list ar1 |
| } $expected |
| |
| do_test 1.$tn.2 { |
| file delete -force ar3 |
| catchcmd test_ar.db $c2 |
| catchcmd test_ar.db $x2 |
| dir_to_list ar3 |
| } $expected |
| |
| do_test 1.$tn.3 { |
| file delete -force ar3 |
| file delete -force test_xyz.db |
| catchcmd ":memory:" $c3 |
| catchcmd ":memory:" $x3 |
| dir_to_list ar3 |
| } $expected |
| |
| # This is a repeat of test 1.$tn.1, except that there is a 2 second |
| # pause between creating the archive and extracting its contents. |
| # This is to test that timestamps are set correctly. |
| # |
| # Because it is slow, only do this for $tn==1. |
| if {$tn==1} { |
| do_test 1.$tn.1 { |
| catchcmd test_ar.db $c1 |
| file delete -force ar1 |
| after 2000 |
| catchcmd test_ar.db $x1 |
| dir_to_list ar1 |
| } $expected |
| } |
| } |
| |
| do_test 2.1.1 { |
| populate_dir ar2 { |
| file1 "abcd" |
| file2 "efgh" |
| junk1 "j1" |
| junk2 "j2" |
| dir1/file3 "ijkl" |
| } |
| populate_dir ar4 { |
| file2 "efgh" |
| } |
| catchcmd shell8.db {.ar -c} |
| catchcmd shell8.db {.ar -C ar2 -i .} |
| catchcmd shell8.db {.ar -r ./file2 ./dir1} |
| catchcmd shell8.db {.ar -g -r ./ju*2} |
| catchcmd shell8.db {.ar -C ar4 -x .} |
| regsub -all {ar4} [dir_content ar4] ar2 |
| } {ar2/file1 ar2/file2 ar2/junk1} |
| |
| finish_test |