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