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
|
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
}
}
}
|
