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 15set testdir [file dirname $argv0] 16source $testdir/tester.tcl 17set testprefix shell8 18 19ifcapable !vtab { 20 finish_test; return 21} 22set CLI [test_find_cli] 23 24proc populate_dir {dirname spec} { 25 # First delete the current tree, if one exists. 26 file delete -force $dirname 27 28 # Recreate the root of the new tree. 29 file mkdir $dirname 30 31 # Add each file to the new tree. 32 foreach {f d} $spec { 33 set path [file join $dirname $f] 34 file mkdir [file dirname $path] 35 set fd [open $path w] 36 puts -nonewline $fd $d 37 close $fd 38 } 39} 40 41proc dir_to_list {dirname {n -1}} { 42 if {$n<0} {set n [llength [file split $dirname]]} 43 44 set res [list] 45 foreach f [glob -nocomplain $dirname/*] { 46 set mtime [file mtime $f] 47 if {$::tcl_platform(platform)!="windows"} { 48 set perm [file attributes $f -perm] 49 } else { 50 set perm 0 51 } 52 set relpath [file join {*}[lrange [file split $f] $n end]] 53 lappend res 54 if {[file isdirectory $f]} { 55 lappend res [list $relpath / $mtime $perm] 56 lappend res {*}[dir_to_list $f] 57 } else { 58 set fd [open $f] 59 set data [read $fd] 60 close $fd 61 lappend res [list $relpath $data $mtime $perm] 62 } 63 } 64 lsort $res 65} 66 67proc dir_compare {d1 d2} { 68 set l1 [dir_to_list $d1] 69 set l2 [dir_to_list $d1] 70 string compare $l1 $l2 71} 72 73foreach {tn tcl} { 74 1 { 75 set c1 ".ar c ar1" 76 set x1 ".ar x" 77 78 set c2 ".ar cC ar1 ." 79 set x2 ".ar Cx ar3" 80 81 set c3 ".ar cCf ar1 test_xyz.db ." 82 set x3 ".ar Cfx ar3 test_xyz.db" 83 } 84 85 2 { 86 set c1 ".ar -c ar1" 87 set x1 ".ar -x" 88 89 set c2 ".ar -cC ar1 ." 90 set x2 ".ar -xC ar3" 91 92 set c3 ".ar -cCar1 -ftest_xyz.db ." 93 set x3 ".ar -x -C ar3 -f test_xyz.db" 94 } 95 96 3 { 97 set c1 ".ar --create ar1" 98 set x1 ".ar --extract" 99 100 set c2 ".ar --directory ar1 --create ." 101 set x2 ".ar --extract --dir ar3" 102 103 set c3 ".ar --creat --dir ar1 --file test_xyz.db ." 104 set x3 ".ar --e --dir ar3 --f test_xyz.db" 105 } 106 107 4 { 108 set c1 ".ar --cr ar1" 109 set x1 ".ar --e" 110 111 set c2 ".ar -C ar1 -c ." 112 set x2 ".ar -x -C ar3" 113 114 set c3 ".ar -c --directory ar1 --file test_xyz.db ." 115 set x3 ".ar -x --directory ar3 --file test_xyz.db" 116 } 117} { 118 eval $tcl 119 120 # Populate directory "ar1" with some files. 121 # 122 populate_dir ar1 { 123 file1 "abcd" 124 file2 "efgh" 125 dir1/file3 "ijkl" 126 } 127 set expected [dir_to_list ar1] 128 129 do_test 1.$tn.1 { 130 catchcmd test_ar.db $c1 131 file delete -force ar1 132 catchcmd test_ar.db $x1 133 dir_to_list ar1 134 } $expected 135 136 do_test 1.$tn.2 { 137 file delete -force ar3 138 catchcmd test_ar.db $c2 139 catchcmd test_ar.db $x2 140 dir_to_list ar3 141 } $expected 142 143 do_test 1.$tn.3 { 144 file delete -force ar3 145 file delete -force test_xyz.db 146 catchcmd ":memory:" $c3 147 catchcmd ":memory:" $x3 148 dir_to_list ar3 149 } $expected 150 151 # This is a repeat of test 1.$tn.1, except that there is a 2 second 152 # pause between creating the archive and extracting its contents. 153 # This is to test that timestamps are set correctly. 154 # 155 # Because it is slow, only do this for $tn==1. 156 if {$tn==1} { 157 do_test 1.$tn.1 { 158 catchcmd test_ar.db $c1 159 file delete -force ar1 160 after 2000 161 catchcmd test_ar.db $x1 162 dir_to_list ar1 163 } $expected 164 } 165} 166 167finish_test 168 169 170 171finish_test 172