Kaido Kert | 25902c6 | 2024-06-17 17:10:28 -0700 | [diff] [blame^] | 1 | # 2017 December 9 |
| 2 | # |
| 3 | # The author disclaims copyright to this source code. In place of |
| 4 | # a legal notice, here is a blessing: |
| 5 | # |
| 6 | # May you do good and not evil. |
| 7 | # May you find forgiveness for yourself and forgive others. |
| 8 | # May you share freely, never taking more than you give. |
| 9 | # |
| 10 | #*********************************************************************** |
| 11 | # |
| 12 | # Test the shell tool ".ar" command. |
| 13 | # |
| 14 | |
| 15 | set testdir [file dirname $argv0] |
| 16 | source $testdir/tester.tcl |
| 17 | set testprefix shell8 |
| 18 | |
| 19 | ifcapable !vtab { |
| 20 | finish_test; return |
| 21 | } |
| 22 | set CLI [test_cli_invocation] |
| 23 | |
| 24 | # Check to make sure the shell has been compiled with ".archive" support. |
| 25 | # |
| 26 | if {[string match {*unknown command*} [catchcmd :memory: .archive]]} { |
| 27 | finish_test; return |
| 28 | } |
| 29 | |
| 30 | proc populate_dir {dirname spec} { |
| 31 | # First delete the current tree, if one exists. |
| 32 | file delete -force $dirname |
| 33 | |
| 34 | # Recreate the root of the new tree. |
| 35 | file mkdir $dirname |
| 36 | |
| 37 | # Add each file to the new tree. |
| 38 | foreach {f d} $spec { |
| 39 | set path [file join $dirname $f] |
| 40 | file mkdir [file dirname $path] |
| 41 | set fd [open $path w] |
| 42 | puts -nonewline $fd $d |
| 43 | close $fd |
| 44 | } |
| 45 | } |
| 46 | |
| 47 | proc dir_content {dirname} { |
| 48 | lsort [glob -nocomplain $dirname/*] |
| 49 | } |
| 50 | |
| 51 | proc dir_to_list {dirname {n -1}} { |
| 52 | if {$n<0} {set n [llength [file split $dirname]]} |
| 53 | |
| 54 | set res [list] |
| 55 | foreach f [glob -nocomplain $dirname/*] { |
| 56 | set mtime [file mtime $f] |
| 57 | if {$::tcl_platform(platform)!="windows"} { |
| 58 | set perm [file attributes $f -perm] |
| 59 | } else { |
| 60 | set perm 0 |
| 61 | } |
| 62 | set relpath [file join {*}[lrange [file split $f] $n end]] |
| 63 | lappend res |
| 64 | if {[file isdirectory $f]} { |
| 65 | lappend res [list $relpath / $mtime $perm] |
| 66 | lappend res {*}[dir_to_list $f] |
| 67 | } else { |
| 68 | set fd [open $f] |
| 69 | set data [read $fd] |
| 70 | close $fd |
| 71 | lappend res [list $relpath $data $mtime $perm] |
| 72 | } |
| 73 | } |
| 74 | lsort $res |
| 75 | } |
| 76 | |
| 77 | proc dir_compare {d1 d2} { |
| 78 | set l1 [dir_to_list $d1] |
| 79 | set l2 [dir_to_list $d1] |
| 80 | string compare $l1 $l2 |
| 81 | } |
| 82 | |
| 83 | foreach {tn tcl} { |
| 84 | 1 { |
| 85 | set c1 ".ar c ar1" |
| 86 | set x1 ".ar x" |
| 87 | |
| 88 | set c2 ".ar cC ar1 ." |
| 89 | set x2 ".ar Cx ar3" |
| 90 | |
| 91 | set c3 ".ar cCf ar1 test_xyz.db ." |
| 92 | set x3 ".ar Cfx ar3 test_xyz.db" |
| 93 | } |
| 94 | |
| 95 | 2 { |
| 96 | set c1 ".ar -c ar1" |
| 97 | set x1 ".ar -x" |
| 98 | |
| 99 | set c2 ".ar -cC ar1 ." |
| 100 | set x2 ".ar -xC ar3" |
| 101 | |
| 102 | set c3 ".ar -cCar1 -ftest_xyz.db ." |
| 103 | set x3 ".ar -x -C ar3 -f test_xyz.db" |
| 104 | } |
| 105 | |
| 106 | 3 { |
| 107 | set c1 ".ar --create ar1" |
| 108 | set x1 ".ar --extract" |
| 109 | |
| 110 | set c2 ".ar --directory ar1 --create ." |
| 111 | set x2 ".ar --extract --dir ar3" |
| 112 | |
| 113 | set c3 ".ar --creat --dir ar1 --file test_xyz.db ." |
| 114 | set x3 ".ar --e --dir ar3 --f test_xyz.db" |
| 115 | } |
| 116 | |
| 117 | 4 { |
| 118 | set c1 ".ar --cr ar1" |
| 119 | set x1 ".ar --e" |
| 120 | |
| 121 | set c2 ".ar -C ar1 -c ." |
| 122 | set x2 ".ar -x -C ar3" |
| 123 | |
| 124 | set c3 ".ar -c --directory ar1 --file test_xyz.db ." |
| 125 | set x3 ".ar -x --directory ar3 --file test_xyz.db" |
| 126 | } |
| 127 | } { |
| 128 | eval $tcl |
| 129 | |
| 130 | # Populate directory "ar1" with some files. |
| 131 | # |
| 132 | populate_dir ar1 { |
| 133 | file1 "abcd" |
| 134 | file2 "efgh" |
| 135 | dir1/file3 "ijkl" |
| 136 | } |
| 137 | set expected [dir_to_list ar1] |
| 138 | |
| 139 | do_test 1.$tn.1 { |
| 140 | catchcmd test_ar.db $c1 |
| 141 | file delete -force ar1 |
| 142 | catchcmd test_ar.db $x1 |
| 143 | dir_to_list ar1 |
| 144 | } $expected |
| 145 | |
| 146 | do_test 1.$tn.2 { |
| 147 | file delete -force ar3 |
| 148 | catchcmd test_ar.db $c2 |
| 149 | catchcmd test_ar.db $x2 |
| 150 | dir_to_list ar3 |
| 151 | } $expected |
| 152 | |
| 153 | do_test 1.$tn.3 { |
| 154 | file delete -force ar3 |
| 155 | file delete -force test_xyz.db |
| 156 | catchcmd ":memory:" $c3 |
| 157 | catchcmd ":memory:" $x3 |
| 158 | dir_to_list ar3 |
| 159 | } $expected |
| 160 | |
| 161 | # This is a repeat of test 1.$tn.1, except that there is a 2 second |
| 162 | # pause between creating the archive and extracting its contents. |
| 163 | # This is to test that timestamps are set correctly. |
| 164 | # |
| 165 | # Because it is slow, only do this for $tn==1. |
| 166 | if {$tn==1} { |
| 167 | do_test 1.$tn.1 { |
| 168 | catchcmd test_ar.db $c1 |
| 169 | file delete -force ar1 |
| 170 | after 2000 |
| 171 | catchcmd test_ar.db $x1 |
| 172 | dir_to_list ar1 |
| 173 | } $expected |
| 174 | } |
| 175 | } |
| 176 | |
| 177 | do_test 2.1.1 { |
| 178 | populate_dir ar2 { |
| 179 | file1 "abcd" |
| 180 | file2 "efgh" |
| 181 | junk1 "j1" |
| 182 | junk2 "j2" |
| 183 | dir1/file3 "ijkl" |
| 184 | } |
| 185 | populate_dir ar4 { |
| 186 | file2 "efgh" |
| 187 | } |
| 188 | catchcmd shell8.db {.ar -c} |
| 189 | catchcmd shell8.db {.ar -C ar2 -i .} |
| 190 | catchcmd shell8.db {.ar -r ./file2 ./dir1} |
| 191 | catchcmd shell8.db {.ar -g -r ./ju*2} |
| 192 | catchcmd shell8.db {.ar -C ar4 -x .} |
| 193 | regsub -all {ar4} [dir_content ar4] ar2 |
| 194 | } {ar2/file1 ar2/file2 ar2/junk1} |
| 195 | |
| 196 | finish_test |