1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
# -*- tcl -*-
# These tests are in the public domain
# -------------------------------------------------------------------------
source [file join \
[file dirname [file dirname [file normalize [info script]]]] \
devtools testutilities.tcl]
testsNeedTcl 8.5 ; # Virt channel support!
testsNeedTcltest 1.0
support {
use virtchannel_base/memchan.tcl tcl::chan::memchan
useLocalFile test-support.tcl
}
testing {
useLocal tar.tcl tar
}
# -------------------------------------------------------------------------
test test-stream {} -setup setup1 -body {
string length [read $chan1]
} -cleanup cleanup1 -result 128000
test tar-pad {} -body {
tar::pad 230
} -result {282}
test tar-skip {} -setup setup1 -body {
tar::skip $chan1 10
lappend res [read $chan1 10]
tar::skip $chan1 72313
lappend res [read $chan1 10]
} -cleanup cleanup1 -result {{6 7 8 9 10} {07 13908 1}}
test tar-seekorskip-backwards {} -constraints tcl8.6plus -setup setup1 -body {
# The zlib push stuff is Tcl 8.6+. Properly restrict the test.
zlib push gzip $chan1
catch {tar::seekorskip $chan1 -10 start} cres
lappend res $cres
catch {tar::seekorskip $chan1 10 start} cres
lappend res $cres
catch {tar::seekorskip $chan1 -10 end} cres
lappend res $cres
catch {tar::seekorskip $chan1 10 end} cres
lappend res $cres
lappend res [read $chan1 10]
} -cleanup cleanup1 -match glob -result [
list {WHENCE=start not supported*} \
{WHENCE=start not supported*} \
{WHENCE=end not supported*} \
{WHENCE=end not supported*} \
{1 2 3 4 5 }
]
test tar-header {} -body {
set file1 [dict get $filesys Dir1 File1]
dict set file1 path /Dir1/File1
set header [header_posix $file1]
set parsed [string trim [tar::readHeader $header]]
set golden "name /Dir1/File1 mode 755 uid 13103 gid 18103 size 100 mtime 5706756101 cksum 3676 type 0 linkname {} magic ustar\0 version 00 uname {} gname {} devmajor 0 devminor 0 prefix {}"
set len [string length $parsed]
foreach {key value} $golden {
if {[set value1 [dict get $parsed $key]] ne $value } {
lappend res [list $key $value $value1]
}
}
} -result {}
test tar-add {} -setup setup1 -body {
tar::create $chan1 [list $tmpdir/one/a $tmpdir/one/two/a $tmpdir/one/three/a] -chan
seek $chan1 0
lappend res {*}[tar::contents $chan1 -chan]
seek $chan1 0
lappend res [string trim [tar::get $chan1 $tmpdir/one/two/a -chan]]
} -cleanup cleanup1 -result {tartest/one/a tartest/one/two/a tartest/one/three/a hello2}
# -------------------------------------------------------------------------
testsuiteCleanup
|
