clang/sqlite | Gitverse

test/shell8.test
222 строки5 KB
dan
When extracting links from sqlar archives, clobber any existing file or link, and do not call utimes() to set the timestamp - it looks through the link and operates on the target.
06 май 2024, 23:21
06 май 2024, 23:2111a088b
# 2017 December 9
#
# The author disclaims copyright to this source code.  In place of
# a legal notice, here is a blessing:
#
#    May you do good and not evil.
#    May you find forgiveness for yourself and forgive others.
#    May you share freely, never taking more than you give.
#
#***********************************************************************
# TESTRUNNER: shell
#
# Test the shell tool ".ar" command.
#

set testdir [file dirname $argv0]
source $testdir/tester.tcl
set testprefix shell8

ifcapable !vtab {
  finish_test; return
}
set CLI [test_cli_invocation]

# Check to make sure the shell has been compiled with ".archive" support.
#
if {[string match {*unknown command*} [catchcmd :memory: .archive]]} {
  finish_test; return
}

proc populate_dir {dirname spec} {
  # First delete the current tree, if one exists.
  file delete -force $dirname
  
  # Recreate the root of the new tree.
  file mkdir $dirname

  # Add each file to the new tree.
  foreach {f d} $spec {
    set path [file join $dirname $f]
    file mkdir [file dirname $path]
    set fd [open $path w]
    puts -nonewline $fd $d
    close $fd
  }
}

proc dir_content {dirname} {
  lsort [glob -nocomplain $dirname/*]
}

proc dir_to_list {dirname {n -1}} {
  if {$n<0} {set n [llength [file split $dirname]]}

  set res [list]
  foreach f [glob -nocomplain $dirname/*] {
    set mtime [file mtime $f]
    if {$::tcl_platform(platform)!="windows"} {
      set perm [file attributes $f -perm]
    } else {
      set perm 0
    }
    set relpath [file join {*}[lrange [file split $f] $n end]]
    lappend res 
    if {[file isdirectory $f]} {
      lappend res [list $relpath / $mtime $perm]
      lappend res {*}[dir_to_list $f]
    } else {
      set fd [open $f]
      set data [read $fd]
      close $fd
      lappend res [list $relpath $data $mtime $perm]
    }
  }
  lsort $res
}

proc dir_compare {d1 d2} {
  set l1 [dir_to_list $d1]
  set l2 [dir_to_list $d1]
  string compare $l1 $l2
}

foreach {tn tcl} {
  1 {
    set c1 ".ar c ar1"
    set x1 ".ar x"

    set c2 ".ar cC ar1 ."
    set x2 ".ar Cx ar3"

    set c3 ".ar cCf ar1 test_xyz.db ."
    set x3 ".ar Cfx ar3 test_xyz.db"
  }

  2 {
    set c1 ".ar -c ar1"
    set x1 ".ar -x"

    set c2 ".ar -cC ar1 ."
    set x2 ".ar -xC ar3"

    set c3 ".ar -cCar1 -ftest_xyz.db ."
    set x3 ".ar -x -C ar3 -f test_xyz.db"
  }

  3 {
    set c1 ".ar --create ar1"
    set x1 ".ar --extract"

    set c2 ".ar --directory ar1 --create ."
    set x2 ".ar --extract --dir ar3"

    set c3 ".ar --creat --dir ar1 --file test_xyz.db ."
    set x3 ".ar --e  --dir ar3 --f test_xyz.db"
  }

  4 {
    set c1 ".ar --cr ar1"
    set x1 ".ar --e"

    set c2 ".ar -C ar1 -c ."
    set x2 ".ar -x -C ar3"

    set c3 ".ar -c --directory ar1 --file test_xyz.db ."
    set x3 ".ar -x --directory ar3 --file test_xyz.db"
  }
} {
  eval $tcl

  # Populate directory "ar1" with some files.
  #
  populate_dir ar1 {
    file1 "abcd" 
    file2 "efgh"
    dir1/file3 "ijkl"
  }
  set expected [dir_to_list ar1]

  do_test 1.$tn.1 {
    catchcmd test_ar.db $c1
    file delete -force ar1
    catchcmd test_ar.db $x1
    dir_to_list ar1
  } $expected

  do_test 1.$tn.2 {
    file delete -force ar3
    catchcmd test_ar.db $c2
    catchcmd test_ar.db $x2
    dir_to_list ar3
  } $expected

  do_test 1.$tn.3 {
    file delete -force ar3
    file delete -force test_xyz.db
    catchcmd ":memory:" $c3
    catchcmd ":memory:" $x3
    dir_to_list ar3
  } $expected

  # This is a repeat of test 1.$tn.1, except that there is a 2 second 
  # pause between creating the archive and extracting its contents.
  # This is to test that timestamps are set correctly.
  #
  # Because it is slow, only do this for $tn==1.
  if {$tn==1} {
    do_test 1.$tn.4 {
      catchcmd test_ar.db $c1
      file delete -force ar1
      after 2000
      catchcmd test_ar.db $x1
      dir_to_list ar1
    } $expected
  }
}

do_test 2.1.1 {
  populate_dir ar2 {
    file1 "abcd" 
    file2 "efgh"
    junk1 "j1"
    junk2 "j2"
    dir1/file3 "ijkl"
  }
  populate_dir ar4 {
    file2 "efgh"
  }
  catchcmd shell8.db {.ar -c}
  catchcmd shell8.db {.ar -C ar2 -i .}
  catchcmd shell8.db {.ar -r ./file2 ./dir1}
  catchcmd shell8.db {.ar -g -r ./ju*2}
  catchcmd shell8.db {.ar -C ar4 -x .}
  regsub -all {ar4} [dir_content ar4] ar2
} {ar2/file1 ar2/file2 ar2/junk1}

# Test symbolic links.
#
if {$tcl_platform(platform)=="unix"} {
  populate_dir ar2 {
    file1 "1234" 
    file2 "3456"
  }
  file link ar2/link1 file1

  forcedelete shell8.db
  forcedelete link1

  do_test 3.1 {
    catchcmd shell8.db {.ar -C ar2 -c file2 link1 }
  } {0 {}}

  do_test 3.2 {
    catchcmd shell8.db {.ar -x} 
  } {0 {}}

  do_test 3.3 {
    catchcmd shell8.db {.ar -x} 
  } {0 {}}
}

finish_test