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
140
141
142
143
144
145
146
147
148
149
|
proc stream {{size 128000}} {
set chan [tcl::chan::memchan]
set line {}
while 1 {
incr i
set istring $i
set ilen [string length $istring]
if {$line ne {}} {
append line { }
incr size -1
}
append line $istring
incr size -$ilen
if {$size < 1} {
set line [string range $line 0 end-[expr {abs(1-$size)}]]
puts $chan $line
break
}
if {$i % 10 == 0} {
puts $chan $line
incr size -1 ;# for the [puts] newline
set line {}
}
}
seek $chan 0
return $chan
}
proc header_posix {tarball} {
dict with tarball {}
tar::formatHeader $path \
[dict create \
mode $mode \
type $type \
uid $uid \
gid $gid \
size $size \
mtime $mtime]
}
proc setup1 {} {
variable chan1
variable res {}
variable tmpdir tartest
tcltest::makeDirectory $tmpdir
foreach directory {
one
one/two
one/three
} {
tcltest::makeDirectory $tmpdir/$directory
set chan [open $tmpdir/$directory/a w]
puts $chan hello[incr i]
close $chan
}
set chan1 [stream]
}
proc large-path {} {
return aaaaa/bbbbaaaaa/bbbbaaaaa/bbbbaaaaa/bbbbaaaaa/bbbbaaaaa/bbbbaaaaa/bbbbaaaaa/bbbbaaaaa/bbbbaaaaa/bbbbtcllib/modules/tar
}
proc setup2 {} {
variable chan1
variable res {}
variable tmpdir tartest
variable tmpfile tarX
tcltest::makeDirectory $tmpdir
tcltest::makeFile {} $tmpfile
foreach directory [list [large-path]] {
tcltest::makeDirectory $tmpdir/$directory
set chan [open $tmpdir/$directory/a w]
puts $chan hello[incr i]
close $chan
}
set chan1 [open $tmpfile w+]
}
proc cleanup1 {} {
variable chan1
close $chan1
tcltest::removeDirectory tartest
return
}
proc cleanup2 {} {
variable chan1
variable tmpdir
variable tmpfile
catch { close $chan1 }
tcltest::removeDirectory $tmpdir
tcltest::removeFile $tmpfile
tcltest::removeFile $tmpfile.err
return
}
variable filesys {
Dir1 {
File1 {
type 0
mode 755
uid 13103
gid 18103
size 100
mtime 5706756101
}
}
Dir2 {
File1 {
type 0
mode 644
uid 15103
gid 19103
size 100
mtime 5706776103
}
}
}
proc setup-tkt-9f4c0e3e95 {} {
variable tmpdir tartest
tcltest::makeDirectory $tmpdir
tcltest::makeFile {zero-two} $tmpdir/02
tcltest::makeFile {number two} $tmpdir/2
set here [pwd]
cd $tmpdir
tar::create t.tar {2 02}
cd $here
return $tmpdir/t.tar
}
proc cleanup-tkt-9f4c0e3e95 {} {
variable tmpdir
tcltest::removeFile $tmpdir/2
tcltest::removeFile $tmpdir/02
tcltest::removeDirectory $tmpdir
return
}
|
