blob: bee603923201221911b900e3614dc6c9c0548f91 [file] [log] [blame]
Kaido Kert25902c62024-06-17 17:10:28 -07001# 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
15set testdir [file dirname $argv0]
16source $testdir/tester.tcl
17set testprefix shell8
18
19ifcapable !vtab {
20 finish_test; return
21}
22set CLI [test_cli_invocation]
23
24# Check to make sure the shell has been compiled with ".archive" support.
25#
26if {[string match {*unknown command*} [catchcmd :memory: .archive]]} {
27 finish_test; return
28}
29
30proc 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
47proc dir_content {dirname} {
48 lsort [glob -nocomplain $dirname/*]
49}
50
51proc 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
77proc 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
83foreach {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
177do_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
196finish_test