gitlab.com/CoiaPrant/sqlite3@v1.19.1/testdata/tcl/shell8.test (about)

     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