test/shell8.test

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