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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
# -*- 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
# Check if we have TclOO available.
tcltest::testConstraint tcloo [expr {![catch {package require TclOO}]}]
support {
if {[tcltest::testConstraint tcloo]} {
use virtchannel_base/memchan.tcl tcl::chan::memchan
}
useLocalFile tests/support.tcl
}
testing {
useLocal tar.tcl tar
}
# -------------------------------------------------------------------------
test tar-stream {stream} -constraints tcloo -setup {
setup1
} -body {
string length [read $chan1]
} -cleanup {
cleanup1
} -result 128000
test tar-pad {pad} -body {
tar::pad 230
} -result {282}
test tar-skip {skip} -constraints tcloo -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 {seekorskip} -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 {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 {add} -constraints tcloo -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}
test tar-bug-2840180 {Ticket 2840180} -setup {
setup2
} -body {
tar::create $chan1 [list $tmpdir/[large-path]/a] -chan
seek $chan1 0
# What the package sees.
lappend res {*}[tar::contents $chan1 -chan]
close $chan1
# What a regular tar package sees.
lappend res [exec 2> $tmpfile.err tar tvf $tmpfile]
join $res \n
} -cleanup {
cleanup2
} -match glob -result [join [list \
tartest/[large-path]/a \
"* tartest/[large-path]/a" \
] \n]
# -------------------------------------------------------------------------
test tar-tkt-9f4c0e3e95-1.0 {Ticket 9f4c0e3e95, A} -setup {
set tarfile [setup-tkt-9f4c0e3e95]
} -body {
string trim [tar::get $tarfile 02]
} -cleanup {
cleanup-tkt-9f4c0e3e95
unset tarfile
} -result {zero-two}
test tar-tkt-9f4c0e3e95-1.1 {Ticket 9f4c0e3e95, B, } -setup {
set tarfile [setup-tkt-9f4c0e3e95]
} -body {
tar::get $tarfile 0b10
} -cleanup {
cleanup-tkt-9f4c0e3e95
unset tarfile
} -returnCodes error -result {Tar "tartest/t.tar": File "0b10" not found}
# -------------------------------------------------------------------------
testsuiteCleanup
|
