AryaWu/sqlite

1# 2017 December 92#3# The author disclaims copyright to this source code.  In place of4# 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: shell12#13# Test the shell tool ".ar" command.14#15 16set testdir [file dirname $argv0]17source $testdir/tester.tcl18set testprefix shell819 20ifcapable !vtab {21  finish_test; return22}23set CLI [test_cli_invocation]24 25# Check to make sure the shell has been compiled with ".archive" support.26#27if {[string match {*unknown command*} [catchcmd :memory: .archive]]} {28  finish_test; return29}30 31proc populate_dir {dirname spec} {32  # First delete the current tree, if one exists.33  file delete -force $dirname34  35  # Recreate the root of the new tree.36  file mkdir $dirname37 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 $d44    close $fd45  }46}47 48proc dir_content {dirname} {49  lsort [glob -nocomplain $dirname/*]50}51 52proc 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) ne "windows"} {59      set perm [file attributes $f -perm]60    } else {61      set perm 062    }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 $fd72      lappend res [list $relpath $data $mtime $perm]73    }74  }75  lsort $res76}77 78proc dir_compare {d1 d2} {79  set l1 [dir_to_list $d1]80  set l2 [dir_to_list $d1]81  string compare $l1 $l282}83 84foreach {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 $tcl130 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 $c1142    file delete -force ar1143    catchcmd test_ar.db $x1144    dir_to_list ar1145  } $expected146 147  do_test 1.$tn.2 {148    file delete -force ar3149    catchcmd test_ar.db $c2150    catchcmd test_ar.db $x2151    dir_to_list ar3152  } $expected153 154  do_test 1.$tn.3 {155    file delete -force ar3156    file delete -force test_xyz.db157    catchcmd ":memory:" $c3158    catchcmd ":memory:" $x3159    dir_to_list ar3160  } $expected161 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 $c1170      file delete -force ar1171      after 2000172      catchcmd test_ar.db $x1173      dir_to_list ar1174    } $expected175  }176}177 178do_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] ar2195} {ar2/file1 ar2/file2 ar2/junk1}196 197# Test symbolic links.198#199if {$tcl_platform(platform)=="unix"} {200  populate_dir ar2 {201    file1 "1234" 202    file2 "3456"203  }204  file link ar2/link1 file1205 206  forcedelete shell8.db207  forcedelete link1208 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 222finish_test223