150 lines
3.0 KiB
Plaintext
150 lines
3.0 KiB
Plaintext
# 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.
|
|
#
|
|
#***********************************************************************
|
|
#
|
|
# Test the shell tool ".ar" command.
|
|
#
|
|
|
|
set testdir [file dirname $argv0]
|
|
source $testdir/tester.tcl
|
|
set testprefix shell8
|
|
set CLI [test_find_cli]
|
|
|
|
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_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]
|
|
set perm [file attributes $f -perm]
|
|
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 --d 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
|
|
}
|
|
|
|
finish_test
|
|
|
|
|
|
|
|
finish_test
|
|
|