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 #
  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