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_find_cli]
  23
  24 proc 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
  41 proc 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
  67 proc 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
  73 foreach {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
 167 finish_test
 168
 169
 170
 171 finish_test